はじめに

今回は、スライド形式だと扱いにくい内容もありますので、bookdownでの作成となっています。 わかりにくい点など、多々あると思いますがよろしくお願いします。

今回、乱数生成するところがありますが、set.seed()を設定していないので実行結果は異なります。

自己紹介

  • @chroneru_mineru
  • R歴はぎゅっとすると2年ぐらい
  • Rについてのブログを書いてる

1 Rのインストール

1.1 windows

  • Rのページに行きます。
  • Mirrors からjapanのミラーサイトを選択してください。
  • Download R x.x.x for Windowsをクリックしてダウンロードして実行する。(x.x.xはバージョンです。)
  • 後はインストーラにしたがってください。

1.2 mac

  • homebrewでのインストールだとこんな感じ
brew tap homebrew/science
brew install r

1.3 linux

  • 簡易的な方法を示します。
  • ubuntu
sudo apt-get install r-base
  • centos
sudo yum install epel-release
sudo yum --enablerepo=epel install R

2 Rstudioのインストール

2.1 windows

  • Rstudioのページからダウンロード，インストールします
  • 別に難しくないですね

2.2 mac

  • homebrewでのインストール
    • brew-cask必須！
brew cask install rstudio

2.3 linux

  • ubuntu
wget https://download1.rstudio.org/rstudio-1.1.447-amd64.deb
sudo dpkg -i rstudio-1.1.447-amd64.deb
  • centos
sudo yum install wget
wget https://download1.rstudio.org/rstudio-1.1.456-x86_64.rpm
sudo yum install rstudio-server-rhel-1.1.442-x86_64.rpm

3 Rの演算子

3.1 算術演算子

  • ふつうの計算に使う
演算子 使い方 結果
+ 1 + 2 3
- 1 - 2 -1
* 2 * 3 6
/ 2 / 3 0.6666667
^ 2 ^ 3 8
%/% 13 %/% 5 2
%% 13 %% 5 3
  • ちなみに
  • 演算子は関数として定義されている
'+'(1, 2)
#> [1] 3

3.2 代入演算子

  • 代入に使う
  • = は非推奨，<- を使う
  • ->も使えるけど、あまりつかわない
  • <<- はグローバル環境への代入
    • <<-よりもassign関数を使うほうがいい
演算子 使い方
<- a <- 3
-> 3 -> a
<<- a <<- 5

4 データ型

4.1 ベクトル

  • Rではベクトルとして代入される。
  • 文字列は""でくくる。
  • 数値はそのまま代入
  • 論理値はTRUEとFALSE
hoge <- "やっほー"
fuga <- 1.414
foo <- TRUE
hoge; fuga; foo
#> [1] "やっほー"
#> [1] 1.414
#> [1] TRUE
  • 複数の値を代入するときはc()を使う
    • 型強制が起こる
      • 数値は文字列に
      • 論理値は数値か文字列に
hoge <- c("やっほー", "おっはー")
fuga <- c(1.414, 1.732)
foo <- c(TRUE,FALSE)
hoge; fuga; foo
#> [1] "やっほー" "おっはー"
#> [1] 1.414 1.732
#> [1]  TRUE FALSE
hoge2 <- c("やっほー", 1, TRUE)
fuga2 <- c(1.414, TRUE)
hoge2; fuga2
#> [1] "やっほー" "1"        "TRUE"
#> [1] 1.414 1.000

4.1.1 クイズ

次のベクトルはどんなデータになるでしょう 

quiz1 <- c(1+TRUE, "やっほー")
quiz2 <- c(1+TRUE, 3) * FALSE

4.1.2 正解は

quiz1
#> [1] "2"        "やっほー"

quiz2
#> [1] 0 0

TRUEは1に，FALSEは0になります。

4.2 リサイクルルール

  • 小さいベクトルが，大きいベクトルにあわせて繰り返されます。
  • ベクトルの長さによって警告が出る
a <- c(1,2,3,4)
b <- c(1,2)
c <- c(1,2,3)
a * 3
#> [1]  3  6  9 12
a + b
#> [1] 2 4 4 6
b + a
#> [1] 2 4 4 6
a * c
#> Warning in a * c: longer object length is not a multiple of shorter object
#> length
#> [1] 1 4 9 4

4.3 ベクトルの要素を参照する

ベクトルの要素は[1]からはじまる!

  • ベクトルの参照は線形代数と一緒
  • [行番号,列番号]で参照する!
a <- c(1,2,3,4)
dim(a) <- c(2,2) #2次元配列
a
#>      [,1] [,2]
#> [1,]    1    3
#> [2,]    2    4

a[1,2]
#> [1] 3

a[c(1,2),2]
#> [1] 3 4
  • 行だけや、列だけは
  • [行番号,] [, 列番号]でそれぞれ参照できる
a[1,]
#> [1] 1 3

a[, 2]
#> [1] 3 4
  • 代入もできる
a
#>      [,1] [,2]
#> [1,]    1    3
#> [2,]    2    4

tmp <- a[2,1]
a[2,1] <- a[1,2]
a[1,2] <- tmp
a
#>      [,1] [,2]
#> [1,]    1    2
#> [2,]    3    4
  • ちなみに
  • [も関数

4.4 NA

  • NAはNot Available
  • なにかわからない値に使う
  • 特別な値
na_vec <- c(NA, NA, NA)
is.na(na_vec)
#> [1] TRUE TRUE TRUE
na_vec + 1
#> [1] NA NA NA
na_vec == 1
#> [1] NA NA NA
na_vec == NA
#> [1] NA NA NA
na_vec != NA
#> [1] NA NA NA

4.5 scanfみたいなのも用意されてる

  • readline関数
a <- readline("入力してね: ")

#> 入力してね: ここに入力
  • これを使うと簡単なクイズができる。

作ってみよう。 

quiz <- function() {
  answer <- "さくらんぼ"
  ans_u <- readline("おうとうってなんだ？: ")
  if (ans_u == answer) print("あってるよ") 
  else print("まちがってるよ")
}
quiz()
#> [1] "あってるよ"

4.6 他の型

NULL symbol pairlist closure
environment promise language special
builtin char logical integer
double complex character bytecode

とか、他にもいっぱいあります。

5 他言語との連携

5.1 C言語

  • さっきのクイズをCにしてみると
#include "/usr/include/stdio.h"
#include "/usr/include/stdlib.h"
#include "/usr/include/string.h"
#include "/usr/include/R/R.h"

void quiz(char **ans_u);

void quiz(char **ans_u) {
  char answer[] = "さくらんぼ";
  char yes[] = "あってるよ";
  char no[] = "まちがってるよ";

  printf("おうとうってなんだ？: %p\n",*ans_u);
  if(strcmp(answer,*ans_u) == 0) {
        printf("%s",yes);
  } else {
        printf("%s",no);
  }
}
  • gccだとエラーは出ないが，危険っぽい
    • ビルド後、読み込むとポインタでエラーが起こる場合がある
gcc -shared -fPIC -I/usr/include/R -o quiz_point.so quiz_point.c
  • Rのバッチコマンドからビルドする
R CMD SHLIB quiz_point.c
dyn.load("./C/quiz_point.so")
ANS <- "さくらんぼ"
.C('quiz', as.character(ANS))
#> list()
#> おうとうってなんだ？: まちがってるよ
dyn.unload("./C/quiz_point.so")
  • R.hのinclude必要!
  • ヘッダファイルのincludeには絶対パスで指定するのが簡単
  • ?.Cでデータ型を確認する
  • gccも使える
    • gccのオプションでヘッダファイルのパスを指定する。
      • -I/usr/include/R
      • R.h内部でRconfig.hが呼び出されるため

5.1.1 Cのコードはめんどい

  • 関数の戻り値はvoidにする。
  • 引数はポインタを使う。
  • RのデータとCの引数の型とが一致しない
  • gccだと.soをつくれてしまう
  • でも、Rバッチだとエラーの特定がしづらい
// プロトタイプ宣言
void hoge(ポインタ);

void hoge(ポインタ) {

}

5.1.2 Rからロード

  • 形式は，.soか.dll
  • dyn.load(“hoge.so”)で読み込む
  • dyn.unload(“hoge.so”)でアンロード
    • Rはメモリだけで処理するのでアンロードしておくといい
    • C言語のfcloseぐらいに思っておく
  • .C('関数名',引数)か.Call()を使う
  • RにはC用のデータ型が用意されている

5.2 シェルスクリプト

  • シェルでも再現してみる。
  • これはけっこう素直に扱える。
#!/bin/sh

if [ $# -eq 1 ] 
then
        echo "おうとうってなんだ？"
        R --vanilla --no-save --slave -f ./quiz_sh.R --args $1

else
        echo "引数の数が正しくありません。"
fi
  • quiz_sh.R
ans_u <- commandArgs(trailingOnly = TRUE)

diagnosis <- c("まちがってるよ\n",
               "あってるよ\n")

cat( ans_u )
cat( "\n" )

cat(diagnosis[ (ans_u == "さくらんぼ") + 1 ])
chmod u+x quiz_sh.sh

5.2.1 commandArgs()

  • trailingOnly = TRUEを指定する。
    • FALSEだとコマンドとオプションも渡される。
  • Rコマンドのオプションに--argsを指定する。
  • 引数を複数わたすこともできる。

5.2.2 shebang

  • シバンを変えることで.Rスクリプトを直接実行できる。
#! /usr/bin/R --vanilla --no-save --slave -f

quiz <- function() {
  answer <- "さくらんぼ"
  ans_u <- readline("おうとうってなんだ？: ")
  if (ans_u == answer) print("あってるよ") 
  else print("まちがってるよ")
}
quiz()
chmod u+x ファイル名

5.3 ヒアドキュメント

  • シェルのヒアドキュメントも使える
R --vanilla --no-save --slave << EOF
quiz <- function() {
  answer <- "さくらんぼ"
  ans_u <- readline("おうとうってなんだ？: ")
  if (ans_u == answer) print("あってるよ") 
  else print("まちがってるよ")
}
quiz()
EOF

5.4 他にも使える言語

  • C++
  • Python
    • reticulateが良さそう
      • ただし、python環境必要
  • Ruby
  • SQL
  • Haskell
  • Rust

などなどいろいろ用意されている。

  • ただし
    • Rubyは直接の使用方法が今のところ無い
library(runr)

rb <- proc_ruby()
rb$start()
rb$exec("puts \"Hello World\" ")
#> puts "Hello World" 
#> # Hello World
rb$stop()

6 パッケージ

6.1 パッケージとは

いろんな人がつくった便利な関数群

  • install.packages()でインストール
  • library()で読み込み
    • require()を使う人もいる。
  • detach()でアンロード
install.packages("パッケージ名")
library(パッケージ名)
detach("package:パッケージ名", unload = TRUE)

6.2 ヒアドキュメント

  • ヒアドキュメントでログをとる。
  • インストール失敗時にべんり!
  • windowsは使えない。
R --no-save << EOF > logfile 2>&1
install.packages("パッケージ名")
EOF

6.3 tidyverse群

  • よくつかわれるパッケージをまとめたもの
  • データ処理につかう
  • パイプ%>%が使える
  • グラフをきれいにかける
install.packages("tidyverse")
library(tidyverse)
  • インストール時につまづきやすい
  • エラーを読むと解決する

6.4 tidyverseの実践

  • ggplotについての例を示す
  • tidyverseパッケージが必要
  • ggplot2パッケージでもOK
library(tidyverse)

6.5 ggplot

  • グラフをつくる関数
  • レイヤーを重ねる
  • 階層グラフィックス文法っていう書き方
  • geom関数でプロットの形式を変えれる
  • ggsave()で簡単にプロットを保存できる
mtcars_tibble <- as_tibble(mtcars)
ggplot(
  data = mtcars_tibble,
  mapping = aes(
    x = mpg,
    y = disp,
    color = cyl
    )
  ) +
  geom_point()

  • tibbleという型をつかう

  • +で関数をつなぐ

  • aes()で設定を行う
  • ggplot()に設定したものが全体の設定になる
    • 変更しない設定は、ggplot()に設定する

7 関数

7.1 function()

  • function()をつかう。
  • ()のなかに引数をあたえる。
  • 中のプログラムは{}でくくる。

7.2 関数例:パレート図の統計量

あんまりよくない

  • 個数を数える
  • 大きいものからならべる(desc)
  • 一個前のを自身に足す
  • 割合を計算する
# a, b, c, d, e の五文字がいくつもあるデータ
# を想定している

pareto_func <- function(vec) {

res_count <- c("a" = NA, "b" = NA, "c" = NA, "d" = NA, "e" = NA)

for(moji in c("a", "b", "c", "d", "e")) {
    res_count[moji] <- sum(vec == moji)
}

res_count <- sort(res_count, decreasing = TRUE)
res_pareto <- cumsum(res_count)
res_pareto <- res_pareto / res_pareto[5]

list("count" = res_count, "density" = res_pareto)
}
  • 一般化していない
  • あとでつかってみます
  • 引数は，仮引数
    • function(a = 5)のようにデフォルトも設定できる
  • c("a" = NA)で名前を与えられる。
    • names(ベクトル)で名前を確認できる。
  • sort()はならべかえ
sort(1:5, decreasing = FALSE)
#> [1] 1 2 3 4 5

sort(1:5, decreasing = TRUE)
#> [1] 5 4 3 2 1
  • cumsum()は累積和
cumsum( c(1, 2, 3, 4, 5))
#> [1]  1  3  6 10 15

8 データ

8.1 read.csv

  • 標準で使える読み込み関数
  • stringAsFactors = FALSEにする
    • 文字列が変化するのを防ぐ
read.csv("ファイル名", stringAsFactors = FALSE)

8.2 read_csv

  • tidyverse群に用意されてる関数(readr)
  • 読み込むと、tibble型になる
read_csv(
  "ファイル名",
  locale = locale(encoding = "エンコード")
)

8.3 write.csv

  • 標準のcsv作成関数
  • row.names = FALSE
    • 行名が追加されるのを防ぐ

8.4 サンプルデータの作成

  • Rにはさまざまなデータ作成関数がある
  • sample()
  • runif()
  • rnorm()
  • rgamma()

8.5 sample

  • sample()で単純なデータを作成できる
  • sizeは何個とりだすか
  • replaceは複数回とりだせるか
  • probは確率を指定する。
    • 合計が1じゃなくても大丈夫
sample(1:100, size = 2)
#> [1] 24 13

8.6 その他

関数 確率分布 使い方
runif() 一様分布 runif(5)
rnorm() 正規分布 rnorm(5)
rgamma() ガンマ分布 rgamma(5,shape = 2, rate = 5)
rbeta() ベータ分布 rbeta(5, shape1 = 0.5, shape2 = 0.5)
  • shapeはk, rateはシータ
  • shape1はα, shape2はβ

9 使用例

9.1 パレート図

# 1から5を一つづつとってくる
prob_vec <- sample(1:5, size = 5)

# 1から5のうちから10000個分とってくる
# 確率は、1から5までで振り分けてある
vec1 <- sample(
  1:5,
  size = 10000,
  replace = TRUE,
  prob = prob_vec
)

# vec1の数を文字列に変える
replace_abcde <- function(vec1) {
  num <- 1
  for(moji in c("a", "b", "c", "d", "e")) {
    vec1[vec1 == num] <- moji
    num <- num + 1
  }

  assign("vec1", vec1, envir = parent.env(environment()))
}

replace_abcde(vec1)
result <- pareto_func(vec1)
result
#> $count
#>    e    a    b    c    d 
#> 3270 2674 2059 1326  671 
#> 
#> $density
#>      e      a      b      c      d 
#> 0.3270 0.5944 0.8003 0.9329 1.0000
  • 図にすると
result <- as_tibble(result) %>% 
  mutate(
    name = names(result$count),
    count_density = count / sum(count)
  )
result %>% 
  ggplot() +
  geom_hline(
    yintercept = c(0.7,0.9,1),
    size = 0.2,
    color = "#ff0000"
  ) +
  geom_bar(
    aes(name, count_density, fill = density),
    stat = "identity"
  ) +
  geom_line(aes(name, density, group ="1")) +
  geom_point(
    aes(name, density, color = density),
    size = 5
  ) +
  scale_x_discrete(limits = result$name) +
  scale_y_continuous(breaks = seq(0, 1, by = 0.1)) +
  scale_color_gradient(low = "#006600", high = "#ccffcc") +
  scale_fill_gradient(low = "#006600", high = "#ccffcc") +
#  viridis::scale_fill_viridis(option="inferno") +
#  viridis::scale_color_viridis() +
  coord_cartesian(ylim = c(0,1)) +
  labs(
    x = names(result$count),
    y = NULL
    ) +
  theme(legend.position = "none")

# ggsave("pareto_graph.png")

10 統計処理

モデリングに関しては、あつかわないので、 実際の統計手法とは異なることに注意してください。

あくまでも、例ですので

10.1 とりあえずやってみる。

  • ToothGrowthというデータセットを使ってみる
head(ToothGrowth)
#>    len supp dose
#> 1  4.2   VC  0.5
#> 2 11.5   VC  0.5
#> 3  7.3   VC  0.5
#> 4  5.8   VC  0.5
#> 5  6.4   VC  0.5
#> 6 10.0   VC  0.5
class(ToothGrowth)
#> [1] "data.frame"
  • モルモットの歯のデータセット
    • VCかオレンジジュース(Oj)の用量と歯の長さ

10.2 方針

  1. tidyverse群がつかえるようにtibbleにする。
  2. 列名をわかりやすくする
  3. とりあえず散布図を作る
  4. 他の処理について考える

10.3 tibble型の威力

ToothGrowth2 <- as_tibble(ToothGrowth)
ToothGrowth2 %>% head() %>% knitr::kable()
len supp dose
4.2 VC 0.5
11.5 VC 0.5
7.3 VC 0.5
5.8 VC 0.5
6.4 VC 0.5
10.0 VC 0.5 
ToothGrowth2 %>% tail() %>% knitr::kable()
len supp dose
24.8 OJ 2
30.9 OJ 2
26.4 OJ 2
27.3 OJ 2
29.4 OJ 2
23.0 OJ 2

10.3.1 列名を変更する

  • ここは参考ぐらいに
names(ToothGrowth2) <- c("Tooth_length", "Supplement", "Dose")
ToothGrowth2 %>% head() %>% knitr::kable()
Tooth_length Supplement Dose
4.2 VC 0.5
11.5 VC 0.5
7.3 VC 0.5
5.8 VC 0.5
6.4 VC 0.5
10.0 VC 0.5

10.3.2 散布図で様子見

ToothGrowth2 %>% 
  ggplot(aes(Dose, Tooth_length, color = Supplement)) +
  geom_point()

10.3.3 線形回帰分析

  • lm()を使う
ToothGrowth2_VC_lm <- lm(Tooth_length ~ Dose, data = ToothGrowth2 %>%
         filter(Supplement == "VC"))
ToothGrowth2_OJ_lm <- lm(Tooth_length ~ Dose, data = ToothGrowth2 %>%
         filter(Supplement == "OJ"))

ToothGrowth2_lm <- list(VC_lm = summary(ToothGrowth2_VC_lm),
                                              OJ_lm = summary(ToothGrowth2_OJ_lm))

ToothGrowth2_lm$VC_lm$coefficients; ToothGrowth2_lm$OJ_lm$coefficients
#>             Estimate Std. Error   t value     Pr(>|t|)
#> (Intercept)  3.29500   1.427060  2.308943 2.854201e-02
#> Dose        11.71571   1.078756 10.860392 1.509369e-11
#>              Estimate Std. Error  t value     Pr(>|t|)
#> (Intercept) 11.550000   1.721951 6.707508 2.788784e-07
#> Dose         7.811429   1.301673 6.001070 1.824801e-06

# Tooth_length = 3.295 + 11.716 * Dose
# Tooth_length = 11.550 + 7.811 * Dose
  • 回帰直線のプロット
  • geom_smoothのmethodを"lm"にする
  • se = FALSEで標準誤差の表示をなくす
ToothGrowth2 %>% 
  group_by(Supplement) %>% 
  ggplot(aes(Dose, Tooth_length, color = Supplement)) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE)

11 ベイズ

11.1 ベイズ統計

  • ToothGrowthでは母集団が少ない。
  • なにもしていない時の歯の増加量がわからない。
  • 特に事前情報がない。


そんなときはベイズ

\[p^{\prime}(H \mid D) = \frac{p(D \mid H) * p(H)}{p(D)}\]

11.2 baysian linear regression

  • 要は線形回帰分析
ToothGrowth2_VC_bayes_lm <- MCMCpack::MCMCregress(
        Tooth_length ~ Dose,
        ToothGrowth2 %>% filter(Supplement == "VC"),
        verbose = 10000)
#> 
#> 
#> MCMCregress iteration 1 of 11000 
#> beta = 
#>    5.47369
#>   10.64170
#> sigma2 =   15.77352
#> 
#> 
#> MCMCregress iteration 10001 of 11000 
#> beta = 
#>    4.01607
#>   11.34625
#> sigma2 =    9.06792
ToothGrowth2_OJ_bayes_lm <- MCMCpack::MCMCregress(
        Tooth_length ~ Dose, 
        ToothGrowth2 %>% filter(Supplement == "OJ"), 
        verbose = 10000)
#> 
#> 
#> MCMCregress iteration 1 of 11000 
#> beta = 
#>   14.17890
#>    6.51548
#> sigma2 =   22.96599
#> 
#> 
#> MCMCregress iteration 10001 of 11000 
#> beta = 
#>   12.42007
#>    7.36562
#> sigma2 =   13.20275
ToothGrowth2_bayes_lm <- list(
        VC_bayes_lm = summary(ToothGrowth2_VC_bayes_lm), 
        OJ_bayes_lm = summary(ToothGrowth2_OJ_bayes_lm))
ToothGrowth2_bayes_lm
#> $VC_bayes_lm
#> 
#> Iterations = 1001:11000
#> Thinning interval = 1 
#> Number of chains = 1 
#> Sample size per chain = 10000 
#> 
#> 1. Empirical mean and standard deviation for each variable,
#>    plus standard error of the mean:
#> 
#>               Mean    SD Naive SE Time-series SE
#> (Intercept)  3.312 1.487  0.01487        0.01452
#> Dose        11.703 1.127  0.01127        0.01127
#> sigma2      14.662 4.276  0.04276        0.04573
#> 
#> 2. Quantiles for each variable:
#> 
#>               2.5%    25%    50%    75%  97.5%
#> (Intercept) 0.4164  2.353  3.325  4.267  6.278
#> Dose        9.4136 10.978 11.702 12.423 13.927
#> sigma2      8.5478 11.647 13.928 16.818 24.859
#> 
#> 
#> $OJ_bayes_lm
#> 
#> Iterations = 1001:11000
#> Thinning interval = 1 
#> Number of chains = 1 
#> Sample size per chain = 10000 
#> 
#> 1. Empirical mean and standard deviation for each variable,
#>    plus standard error of the mean:
#> 
#>               Mean    SD Naive SE Time-series SE
#> (Intercept) 11.571 1.794  0.01794        0.01752
#> Dose         7.796 1.360  0.01360        0.01360
#> sigma2      21.347 6.226  0.06226        0.06658
#> 
#> 2. Quantiles for each variable:
#> 
#>               2.5%    25%    50%    75% 97.5%
#> (Intercept)  8.077 10.413 11.586 12.723 15.15
#> Dose         5.034  6.922  7.795  8.665 10.48
#> sigma2      12.445 16.958 20.279 24.486 36.19

# Tooth_length = 3.312 + 11.703 * Dose
# Tooth_length = 11.571 + 7.796 * Dose
Intercept <- c(ToothGrowth2_bayes_lm$VC_bayes_lm$statistics[1,1],
                ToothGrowth2_bayes_lm$OJ_bayes_lm$statistics[1,1])
slope <- c(ToothGrowth2_bayes_lm$VC_bayes_lm$statistics[2,1],
                ToothGrowth2_bayes_lm$OJ_bayes_lm$statistics[2,1])
Intercept; slope
#> [1]  3.312116 11.570653
#> [1] 11.703262  7.796404
# Tooth_length = 3.312 + 11.703 * Dose
# Tooth_length = 11.571 + 7.796 * Dose
ToothGrowth2 %>% 
  group_by(Supplement) %>% 
  ggplot(aes(Dose, Tooth_length, color = Supplement)) +
  geom_point() +
  geom_smooth(method = "lm", se = FALSE, size = 2) +
  stat_function(
    fun = function(Dose) Intercept[1] + slope[1] * Dose,
    geom = "line",
    color = "#00ffc4",
    size = 0.6,
    xlim = c(0.5, 2.0),
    show.legend = TRUE
  ) +
  stat_function(
    fun = function(Dose) Intercept[2] + slope[2] * Dose,
    geom = "line",
    color = "#ffe4f1",
    size = 0.5,
    xlim = c(0.5, 2.0),
    show.legend = TRUE
  )

11.3 MCMCregress

  • MCMCpackパッケージを使う。
  • MCMCpack::MCMCregressでMCMC法での回帰直線を作成する。
  • デフォルトでバーンインは1000回,イテレーションは10000回
  • verboseを設定すると進行状況と各変数の確率分布をprintで表示できる。

MCMC法による線形回帰の結果を通常の線形回帰分析と重ねあわせてみると

  • だいたいおなじ

12 BayesFactor

12.1 ベイズファクター

  • 尤度を比較する指標
  • 事後確率の比と事前確率の比の比
    • すごいわかりづらい


ある仮説のときにデータがこうなってるよね?
これって別の仮説の時のデータだとしたらどっちいいんかな?ってこと


\[\frac{p^{\prime} (H_{1} \mid D)}{p^{\prime}(H_0 \mid D)} = \frac{p(D \mid H_{1}) * p(H_{1})}{p(D \mid H_{0}) * p(H_{0})}\]

  • つまり

\[\frac{p(D \mid H_{1})}{p(D \mid H_{0})} = \frac{\frac{p^{\prime}(H_{1} \mid D)}{p(H_{1})}}{\frac{p^{\prime}(H_{0} \mid D)}{p(H_{0})}}\]

12.2 anovaBF

  • BayesFactor::anovaBF
    • 分散を解析する関数
  • factorじゃないと使えないらしい
  • 質的変数として扱えるならそうする
    • Doseは比例尺度と考えられる(量的変数)
    • 今回は順位尺度と見る
# そのままやるとエラーになる
bf <- BayesFactor::anovaBF(
  Tooth_length ~ Dose,
  data = ToothGrowth2
  )
#> Warning: data coerced from tibble to data frame
#> Error in createDataTypes(formula, whichRandom, data, analysis = "anova"): anovaBF() cannot be used with nonfactor independent variables. Use lmBF(), regressionBF(), or generalTestBF() instead.

12.3 anovaBFの使用

  • 公式にのっとってデータを整理していく
ToothGrowth2$Dose <- factor(ToothGrowth2$Dose)
levels(ToothGrowth2$Dose) <- c("Low", "Medium", "High")
bf <- BayesFactor::anovaBF(
  Tooth_length ~ Supplement * Dose,
  data = ToothGrowth2
  )
#> Warning: data coerced from tibble to data frame
#> 
  |                                                                       
  |                                                                 |   0%
  |                                                                       
  |================                                                 |  25%
  |                                                                       
  |================================                                 |  50%
  |                                                                       
  |=================================================                |  75%
  |                                                                       
  |=================================================================| 100%
bf
#> Bayes factor analysis
#> --------------
#> [1] Supplement                          : 1.198757     ±0.01%
#> [2] Dose                                : 4.983636e+12 ±0%
#> [3] Supplement + Dose                   : 2.776051e+14 ±1.05%
#> [4] Supplement + Dose + Supplement:Dose : 7.855115e+14 ±1.95%
#> 
#> Against denominator:
#>   Intercept only 
#> ---
#> Bayes factor type: BFlinearModel, JZS
bf[3:4] / bf[2]
#> Bayes factor analysis
#> --------------
#> [1] Supplement + Dose                   : 55.70333 ±1.05%
#> [2] Supplement + Dose + Supplement:Dose : 157.6181 ±1.95%
#> 
#> Against denominator:
#>   Tooth_length ~ Dose 
#> ---
#> Bayes factor type: BFlinearModel, JZS
  • 今回はplotが用意されているのでplot()を使う
plot(bf)
plot(bf[3:4]/bf[2])

プロット結果

  • 見た感じSupplementは関係なさそう
  • Supplement + Dose + Supplement:Doseで仮設を立てるのが最も良さそう

というわけでfactorをnumericにするんですが 少し失敗しました。笑

levels(ToothGrowth2$Dose) <- c(0.5, 1, 2)
ToothGrowth2$Dose <- as.numeric(as.character(ToothGrowth2$Dose))
str(ToothGrowth2$Dose)
#>  num [1:60] 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 0.5 ...

12.4 ふたたび線形回帰分析

  • 手順は同じ
# Tooth_length = b0 + b1*Supplement + b2*Dose + b3*Supplement*Dose
ToothGrowth_lm_result <- lm(Tooth_length ~ Supplement * Dose, data = ToothGrowth2)
summary(ToothGrowth_lm_result)
#> 
#> Call:
#> lm(formula = Tooth_length ~ Supplement * Dose, data = ToothGrowth2)
#> 
#> Residuals:
#>     Min      1Q  Median      3Q     Max 
#> -8.2264 -2.8462  0.0504  2.2893  7.9386 
#> 
#> Coefficients:
#>                   Estimate Std. Error t value Pr(>|t|)    
#> (Intercept)         11.550      1.581   7.304 1.09e-09 ***
#> SupplementVC        -8.255      2.236  -3.691 0.000507 ***
#> Dose                 7.811      1.195   6.534 2.03e-08 ***
#> SupplementVC:Dose    3.904      1.691   2.309 0.024631 *  
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> Residual standard error: 4.083 on 56 degrees of freedom
#> Multiple R-squared:  0.7296, Adjusted R-squared:  0.7151 
#> F-statistic: 50.36 on 3 and 56 DF,  p-value: 6.521e-16
  • ggplotを使っていく
ToothGrowth2 <- ToothGrowth2 %>% 
  mutate(
    Supplement_num = unclass(.$Supplement),
    Tooth_length_res = predict(ToothGrowth_lm_result)
  )
ToothGrowth2 %>% head() %>% knitr::kable()
Tooth_length Supplement Dose Supplement_num Tooth_length_res
4.2 VC 0.5 2 9.152857
11.5 VC 0.5 2 9.152857
7.3 VC 0.5 2 9.152857
5.8 VC 0.5 2 9.152857
6.4 VC 0.5 2 9.152857
10.0 VC 0.5 2 9.152857 
par(mfrow = c(2, 2))
plot(ToothGrowth_lm_result)

  • 残差が同じぐらいの広がり
  • 正規性が見て取れる
  • クックの距離が0.5を超えているようなので当てはまりもよさそう
    • 目盛りが狭すぎて見づらいけど
ToothGrowth2 %>% 
  ggplot(aes(Dose, color = Supplement)) +
  geom_point(aes(y = Tooth_length_res) , 
                         position = position_jitter(width = 0.1, height = 1),
                         color = "#0000ff") +
  geom_point(aes(y = Tooth_length) , 
                         position = position_jitter(width = 0.1)
                        ) +
    facet_wrap(~ Supplement)

  • 95%信頼区間でのみb3 * Supplement * Doseが棄却される。
  • イテレーションしたらもう少し違うかも。

13 rmarkdown

13.1 rmarkdownの準備

  • File > New File > R markdown > Document HTML(ラジオボタン) > OK
  • はじめてrmdファイルを作ろうとするとエラーが出る
    • 出ない人もいるかもです
  • とりあえず，インストールしてください。
install.packages(c("bitops", "caTools"))

13.2 yamlヘッダ

  • 出力するファイルのオプションを設定
---
title: "たいとる"
author: "書いた人"
date: "日付"
output: 出力形式: 
    css: "cssのパス"
    self_contained: TRUEかFALSE
---
  • レベルを下げる場合は、タブ1つかスペース4つ
  • self_containedは、jsとかをまとめるかどうか
    • 通常はTRUEを使う

13.3 出力形式

指定方法 出力形式
html_document html
pdf_document pdf
word_document word
ioslides_presentation htmlのスライド
revealjs::revealjs_presentation イケてるスライド
bookdown::gitbook 本
  • bookdownは、今回の資料で使った形式
    • pdf_bookやepub_bookがある
  • 他にもいろいろな出力形式がある
  • pdfはlatexをつかうので、ハマる
#CRANから
install.packages("revealjs")

#githubから
install.packages("devtools")
devtools::install_github("rstudio/revealjs")
install.packages("bookdown")

13.4 pdfの出力

  • pdfを出力するとエラーが出る
  • texライブラリが足りないみたい
  • 日本語はutf-8にすると闇が深い
output: pdf_document
    
Ctrl + Shift + K (knit)

13.4.1 texのログファイル

  • pdfをレンダリングするとログが出るので読む
    • 大事なところだけでいい
! LaTeX Error: File `titling.sty' not found.
!  ==> Fatal error occurred, no output PDF file produced!
  • titling.styがないということ
Package microtype Warning: You don't seem to be using pdftex, luatex or xetex.
(microtype)                `microtype' only works with these engines.
(microtype)                I will quit now.

)

! Package microtype Error: The protrusion set `basicmath' is undeclared.
(microtype)                Using set `\MT@default@pr@set ' instead.
  • microtypeはpdftex, luatex, xetexでしか働かない

13.4.2 texライブラリ

  • texライブラリを追加すればOK

  • titling.styの場合
    • 他のstyの場合は、titlingの部分を読み替えてください

  • wgetを使う場合は、CTANで必要なzipのURLを取得してください

wget ftp://ftp.jaist.ac.jp/pub/CTAN/macros/latex/contrib/titling.zip
unzip titling.zip
cd titling.zip
latex titling.ins
sudo cp titling.sty /usr/share/texlive/texmf-dist/tex/latex/titling/
sudo texhash
  • 必要ないかもだけど一応
# You are recommended to install the tinytex package to build PDF.FALSE
On Rstudio
install.packages("tinytex")

13.5 styのインストール

  • さっきの方法でもいけるけど、リポジトリにある場合もある
  • yum, aptでもいける
sudo yum install texlive-*
sudo apt-get install texlive-*

13.6 texエンジン

  • yamlヘッダにlatex_engineを指定する
  • 日本語はlualatexかxelatex
  • pdflatexでも日本語化できるけど、SJISじゃないとエラーがいっぱい
  • includesでパッケージを指定できる
    • 例として挙げてますが、\usepackageの部分は無視してください
    • たぶん、エラー出ます
---
output: pdf_document: 
    latex_engine: lualatex
    header-includes: 
        - \usepackage[utf-8]{inputenc} //絶対やらないでくださいハマります
---

13.7 includes

  • yamlヘッダでファイルの読み込みもできる
  • pdfの場合、preamble.texファイルを読み込むのが主流
---
output:
    html_document:
        include:
            in_header: ファイル名
            before_body: ファイル名
            after_body: ファイル名
    pdf_document:
        includes:
            in_header: preamble.tex
            before_body: before_body.tex
            after_body: after_body.tex
        latex_engine: xelatex
---

13.8 コードチャンク

13.8.1 コードチャンクの書き方

  • 先頭の\はエスケープです。
  • 取り除いてください。
\```{r}
\Rのコード 
\```
  • Ctrl + Alt + I でチャンクを追加できる

13.9 チャンクオプション

  • {r チャンク名, オプションの指定}
オプション T, F 結果
include FALSE コードと結果を表示しない
echo FALSE コードを表示しない
message FALSE メッセージを表示しない
eval FALSE 実行しない
  • ほかにもいろいろある
  • オプションのチェック方法
    • knitr::opts_chunk$get

13.10 setupチャンク

  • {r setup, include = FALSE}
  • setupのチャンクは一度しか使えない。
  • include = FALSEがよく使う指定。
    • コードチャンクを表示しない
  • 今回は次のように設定してある。
  • bookdownは違う設定をしてある。
\```{r setup, include=FALSE}
knitr::opts_chunk$set(
  comment = "#>",
  collapse = TRUE,
  fig.show = "hold"
)
\```

13.11 エンジン

  • {r チャンク名, engine="言語名"}
  • ```言語名:チャンク名
  • {言語名 チャンク名, オプション}

他言語 に書いた言語以外にもいろいろ使える。

13.12 tex数式

  • インラインは$数式$
  • ブロックラインは$$数式$$

たとえば,\(E=mc^2\), \(mgh=\frac{1}{2}mv^2\)

\[E=mc^2\] \[mgh=\frac{1}{2}mv^2\]

13.13 texコマンド

  • コマンドは\をつける
コマンド 効果
\text 演算子など記号を文字にする
{\rm } 文字がイタリックになるのをやめる
_{} 下付き文字
^{} 上付き文字
\theta \(\theta\)ギリシャ文字(ほかにも使えます)
\frac{a}{b} \(\frac{a}{b}\)の分数をつくる
\int_a^b \(\int_a^b\)こんな感じの積分を作る
  • 他にもいっぱい用意されている

14 shiny

ui <- fluidPage(
  titlePanel("たいとる"),
  mainPanel(),
  sidebarPanel()
)

server <- function(input, output) {
  
}

shinyApp(ui = ui, server = server)

14.1 widget

  • さっきのはシンプルな形
  • 入力フォームや出力などのウィジェットを定義する。
ls(envir = environment(shiny::numericInput)) %>% 
  # ..*で任意の一文字以上, (Input|Output)でInputまたはOutput, $は行末のアンカー
  str_subset("..*(Input|Output)$") 
#>  [1] "cancelOutput"                  "checkboxGroupInput"           
#>  [3] "checkboxInput"                 "dataTableOutput"              
#>  [5] "dateInput"                     "dateRangeInput"               
#>  [7] "fileInput"                     "htmlOutput"                   
#>  [9] "imageOutput"                   "numericInput"                 
#> [11] "passwordInput"                 "plotOutput"                   
#> [13] "restoreInput"                  "selectInput"                  
#> [15] "selectizeInput"                "serializerFileInput"          
#> [17] "sliderInput"                   "snapshotPreprocessInput"      
#> [19] "snapshotPreprocessorFileInput" "snapshotPreprocessOutput"     
#> [21] "tableOutput"                   "textAreaInput"                
#> [23] "textInput"                     "textOutput"                   
#> [25] "uiOutput"                      "updateCheckboxGroupInput"     
#> [27] "updateCheckboxInput"           "updateDateInput"              
#> [29] "updateDateRangeInput"          "updateNumericInput"           
#> [31] "updateSelectInput"             "updateSelectizeInput"         
#> [33] "updateSliderInput"             "updateTextAreaInput"          
#> [35] "updateTextInput"               "verbatimTextOutput"

ui <- fluidPage(
  titlePanel("numericInput&sliderInput"),
  fluidRow(
    column(6,
           numericInput("test_num", "数字を入力してね", value = NA, min = 0, max = 20)),
    column(6,
            sliderInput("test_slide", "スライドしよう", min = 0, max = 100, value = 20))
  ),
  textOutput("test_text")
)

server <- function(input, output) {
  output$test_text <- renderText({
    paste0("入力した数字は,", input$test_num, "スライダーの数字は,", input$test_slide)
  })
}

shinyApp(ui = ui, server = server)

  • output$id名に出力を代入する。

  • render系の関数は出力時に使う。

ls(envir = environment(shiny::renderText)) %>% 
  str_subset(".*render.*")
#>  [1] "as.tags.shiny.render.function"    "knit_print.shiny.render.function"
#>  [3] "renderDataTable"                  "renderImage"                     
#>  [5] "renderPage"                       "renderPlot"                      
#>  [7] "renderPrint"                      "renderReactLog"                  
#>  [9] "renderTable"                      "renderText"                      
#> [11] "renderUI"

14.2 reactive

いままでやったのはreactivityとは少し違う。

  • render*はinputの値が変わるたびに、再実行する。
  • つまり、不要な更新も行われるということ。
  • さっきの例だと
    • numericInputの値しか変わらないのにsliderInputの値を再代入してしまう。

reactive()を使おう!

14.2.1 reactiveを使ってみる。

ui <- fluidPage(
  titlePanel("numericInput&sliderInput"),
  fluidRow(
    column(6,
           numericInput("test_num", "数字を入力してね", value = NA, min = 0, max = 20)),
    column(6,
            sliderInput("test_slide", "スライドしよう", min = 0, max = 100, value = 20))
  ),
  textOutput("test_text")
)

server <- function(input, output) {
  reactive_test_num <- reactive(list(input$test_num, input$test_slide))
  output$test_text <- renderText({
    paste0("入力した数字は,", reactive_test_num()[[1]], "スライダーの数字は,", reactive_test_num()[[2]])
  })
}

shinyApp(ui = ui, server = server)
  • reactiveは関数オブジェクトの形をとる。

  • [[]]でのアクセスは、ベクトルを返させる。

  • reactiveの関数は、{}でくくると複数行の表現式を受け取れる。
  • reactiveは、メモリ中のinput変数が変わったら、再実行される。
    • 変わらなければ再代入されない。

  • なんども関数を実行することは速度の低下につながる。

14.3 observer

  • observeは常にinputを監視する。
  • 挙動はreactiveと同じ。
ui <- fluidPage(
  titlePanel("numericInput&sliderInput"),
  fluidRow(
    column(6,
           numericInput("test_num", "数字を入力してね", value = NA, min = 0, max = 20)),
    column(6,
            sliderInput("test_slide", "スライドしよう", min = 0, max = 100, value = 20))
  ),
  textOutput("test_text")
)

server <- function(input, output) {
  #observe(list(input$test_num, input$test_slide))
  observe_test <- reactiveValues()
  observe({observe_test$num <- input$test_num; observe_test$slide <- input$test_slide})
  output$test_text <- renderText({
    paste0("入力した数字は,",
           #input$test_num,
           observe_test$num,
           "スライダーの数字は,",
           #input$test_slide
           observe_test$slide)
  })
}

shinyApp(ui = ui, server = server)
  • observe()は,reactiveと決定的に違う。
  • inputが変わらなくても、observe内の関数を再実行する。
    • render*内の関数を外に押し出すのにいいかも。
  • observe()が監視するのは、reacitveな表現式(オブジェクト)
  • reactiveValues()は、reactiveなオブジェクトを生成する
    • classみたいなもん

14.4 endpoint

  • render*の関数
mermaid("
        graph LR
          id1[reactive]
          id2{observer}
          id3>endpoint]
        
          id1---id2
          id2---id3")
  • イメージとしてはこんな感じ
  • 最後にrender*でoutputにわたす
    • renderText()をさっき使った
  • mermaid()は後述
ui <- fluidPage(
  titlePanel("numericInput&sliderInput"),
  fluidRow(
    column(6,
           numericInput("test_num", "数字を入力してね", value = NA, min = 0, max = 20)),
    column(6,
            sliderInput("test_slide", "スライドしよう", min = 0, max = 100, value = 20))
  ),
  dataTableOutput("test_table")
)

server <- function(input, output) {
  check_var <- reactive(data.frame(num = input$test_num, slide = input$test_slide))
  DT <- reactiveValues(table_1 = NA)

    # 直接 table_1 に代入すると
    # reactiveじゃないのでエラーになる
    #observe(table_1 <- as.data.frame(check_var()))

  observe(DT$table_1 <- as.data.frame(check_var()))
  # output$test_table <- renderDataTable({as.data.frame(check_var())})
  output$test_table <- renderDataTable(DT$table_1)
}

shinyApp(ui = ui, server = server)
  • renderDataTable()はdata.frameとmatrixを出力
  • renderTable()はxtable::xtableを使うので注意！
  • 詳しくは?shiny::renderDataTable

基本的には, reactive, endpoint, がわかればOK!

14.5 shinyのレイアウト

14.5.1 *Panel

  • 基本的には*Panelで書けばいい。
  • sidebarLayout()も簡単
ls(envir = environment(shiny::titlePanel)) %>% 
  str_subset(".*Panel$")
#>  [1] "absolutePanel"      "conditionalPanel"   "fixedPanel"        
#>  [4] "headerPanel"        "inputPanel"         "mainPanel"         
#>  [7] "navlistPanel"       "sidebarPanel"       "tabPanel"          
#> [10] "tabsetPanel"        "titlePanel"         "updateNavlistPanel"
#> [13] "updateTabsetPanel"  "wellPanel"

14.5.2 fluidRow

  • fluidRow()の中にcolumn(width, )でレイアウトしていく
    • いままで使ってたやつ
  • column(width, )のwidthは,同一のfluidRow()内で合計12になるようにする。
    • 2つに等分するならwidth = 6
    • 3等分ならwidth = 4
    • 自由に、width = 2, width = 4 , width = 6もOK

14.5.3 css

  1. app.R, ui.R, server.Rのあるところにcssを置く

  2. shiny::includeCSS()でcssファイルを指定する。(パス無し)

  3. wwwディレクトリをapp.R, ui.R, server.Rのあるところに作る
  4. www内にcssファイルを置く
  5. fluidPage(theme = "css", )で指定する。

  6. tags$head()内のtags$link()で設定する

  • tags$head()内のtags$style()で直接スタイルを書く
h1, h2, h3 {
    color: red;
    font-size: 10em;
}

body {
    background-color: grey;
}

ui <- fluidPage(
  #失敗,たぶんリポジトリのディレクトリ構造が干渉してる
  # theme = "shiny_css/test_shiny_css.css",
  #失敗,たぶん上と同じ理由
    # tags$head(
    #   tags$link(rel = "stylesheet", type = "text/css", href = "shiny_css/test_shiny_css.css")
    # ),
  #これはうまくいく。パスはRmd起点にしてある。
  #includeCSS("www/shiny_css/test_shiny_css.css"),
  
  headerPanel("numericInput&sliderInput"),
  fluidRow(
    column(6,
           numericInput("test_num", "数字を入力してね", value = NA, min = 0, max = 20)),
    column(6,
            sliderInput("test_slide", "スライドしよう", min = 0, max = 100, value = 20))
  ),
  dataTableOutput("test_table")
)

server <- function(input, output) {
  check_var <- reactive(data.frame(num = input$test_num, slide = input$test_slide))
    DT <- reactiveValues(table_1 = NA)
  observe({DT$table_1 <- as.data.frame(check_var())})
  output$test_table <- renderDataTable(DT$table_1)
}

shinyApp(ui = ui, server = server)
  • ちょー見づらいけど、テストだからわかりやすく。

14.5.4 googleapi

  • googleapiのcssを@importする
  • 日本語は開発中らしい
  • earlyaccessでcssを読み込める
  • コメントアウトは外してください
ui <- fluidPage(
  tags$head(
    tags$style(HTML("
/*
                    @import url(//fonts.googleapis.com/earlyaccess/nicomoji.css);
                    h1, h2, h3, h4, h5, h6, p {
                      font-family: 'Nico Moji', cursive;
                    }
*/

/*
                    @import url(//fonts.googleapis.com/earlyaccess/hannari.css);
                    h1, h2, h3, h4, h5, h6, p {
                      font-family: 'Hannari', serif;
                    }
*/
                    "))
  ),
  
  headerPanel("数字の入力練習"),
  fluidRow(
    column(6,
           numericInput("test_num", "数字を入力してね", value = NA, min = 0, max = 20)),
    column(6,
            sliderInput("test_slide", "スライドしよう", min = 0, max = 100, value = 20))
  ),
  dataTableOutput("test_table")
)

server <- function(input, output) {
  check_var <- reactive(data.frame(num = input$test_num, slide = input$test_slide))
  output$test_table <- renderDataTable({as.data.frame(check_var())})
}

shinyApp(ui = ui, server = server)

15 htmlwidgets

15.1 htmlwidgetsとは

  • javascriptをつかってRをインタラクティブにしようってこと
  • html系ならなんでも組み合わせられる
  • ただし、相互干渉の可能性あり
  • いっぱいあります
    • 今回はleafletとDiagrammeRを紹介
    • 主にDiagrammeR

15.2 leaflet

  • いけいけなマップを生成する。
# ダブルクウォーテーションを使う場合
mermaid('
        graph LR
        first["leaflet()"]
        second["addTiles()"]
        last[他の情報]
        
        first --> second
        second --> last')

map_df <- data.frame(
  popup = c("はこだて", "函館駅", "新函館北斗駅", "MIRAI BASE"),
  lng = c(140.72881, 140.7277, 140.648376, 140.757159),
  lat = c(41.768793, 41.773269, 41.904698, 41.814461)
)

# 函館駅と新函館北斗駅を結ぶ
leaflet() %>% 
  addTiles() %>% 
  addMarkers(lng = map_df$lng[2:3], lat = map_df$lat[2:3], popup = map_df$popup[2:3]) %>% 
  addPolylines(lng = map_df$lng[2:3], lat = map_df$lat[2:3])
  • leaflet()とaddTiles()でマップを用意
  • addMarkersでマークする
    • lngは経度、 latは緯度
  • addPolylines()で直線を引く

15.3 Leaflet Route Machine

  • 経路探索用のleafletプラグイン
  • まだleafletには用意されてない。
  • rMapsを使う。
    • rChartsが依存関係
R --no-save << EOF > install_rCharts.log 2>&1
devtools::install_github("rmnathv/rCharts")
EOF
R --no-save << EOF > install_rMaps.log 2>&1
devtools::install_github("rmnathv/rMaps")
EOF
  • 絶賛失敗中です。
  • jsコード読んでないのでどこが悪いかわからない。
  • そのうち完成させます。
library(rMaps); library(leaflet)
map <- Leaflet$new()
map$setView(c(map_df$lat[1], map_df$lng[1]), zoom = 15)
#map$marker(c(map_df$lat[2], map_df$lng[2]), bindpopup = map_df$popup[2])
#map$marker(c(map_df$lat[4], map_df$lng[4]), bindpopup = map_df$popup[4])
map$addAssets(css = c("https://unpkg.com/leaflet@1.2.0/dist/leaflet.css", "https://unpkg.com/leaflet-routing-machine@latest/dist/leaflet-routing-machine.css"),
              jshead = c("https://unpkg.com/leaflet-routing-machine@latest/dist/leaflet-routing-machine.js", "https://unpkg.com/leaflet@1.2.0/dist/leaflet.js"))
map$setTemplate(afterScript = sprintf("
<script>
  L.Routing.control({
    waypoints: [
      L.latlng(41.77327, 140.7277),
      L.latlng(41.81446, 140.7572)
    ]
}).addTo(map);
</script>
"))
map

15.4 libpng

  • leafletのインストール時にエラーが出る場合がある。
/bin/sh: libpng-config: command not found
read.c:3:17: 致命的エラー: png.h: No such file or directory
 #include <png.h>

 ERROR: compilation failed for package ‘png’
  • 一応、失敗例も
  • wget以下が成功例
# 失敗
sudo yum install libpng-config

# 失敗
sudo yum install libpng.x86_64

# 成功
wget http://prdownloads.sourceforge.net/libpng/libpng-1.6.34.tar.gz
tar zxvf libpng-1.6.34.tar.gz
cd libpng-1.6.34
./configure
make
sudo make install

export CPLUS_INCLUDE_PATH=/usr/local/include
export LD_LIBRARY_PATH=/usr/local/lib
export LIBRARY_PATH=/usr/local/lib
R --no-save << EOF > install_png.log 2>&1
install.packages("png")
EOF
R --no-save << EOF > install_leaflet.log 2>&1
install.packages("leaflet")
EOF

16 DiagrammeR

16.1 DiagrammeRとは

  • graphvizとmermaidが主力
  • パイプを使った図の生成も可能
  • DOT言語をベースにしている記述方法
    • 方言がある

16.2 graphviz

16.2.1 grViz関数

grViz("
digraph prac_grviz {
      //グラフ全体の設定
      graph [ rankdir = LR ]

      //ノードの設定
      node []
      a; b; c;

      //エッジの設定
      edge []

      a -> b -> c
     
}
      ")
  • コメントアウトは//, /* */, # が使える。
  • digraph グラフ名 { グラフの情報 }で書く
  • ダウンストリーム的に上から下に順ぐりに書く

  • ->で有向, --で無向

  • graph[]でグラフ全体の設定をする
    • rankdirは全体の方向を設定する
      • TB, LRはそれぞれ
        • Top to Bottom 上から下
        • Left to Right 左から右
grViz("
      digraph gogyo {
      
      graph [ charset = 'UTF-8' ]
      
      node [ shape = 'circle']
      a [ label = '木' ];
      b [ label = '火' ];
      c [ label = '土' ];
      d [ label = '金' ];
      e [ label = '水' ];
      
      edge []
      a -> b -> c -> d -> e [ arrowhead = 'none' ]
      a -> c -> e -> b -> d -> a

      }
      ")

  • graph [ charset = '文字コード' ]で文字コードを設定する。

  • [label = 'なまえ']で表示する名前を書きます。
  • [shape = 'circle']でノードの形を設定します。

  • [arrowtail = 'none', arrowhead = 'none']でエッジの設定をします。

  • 五行を書いてみたのですが、全然綺麗じゃないですね。

grViz("
      digraph gogyo_resetting {
      
      graph [ charset = 'UTF-8',
              rankdir = TB,
              // layout = dot
              // layout = neato
              // layout = twopi
              layout = circo
            ]
      
      node [ shape = 'circle',
             width = 0.9 ]
      a [ label = '木' ];
      b [ label = '火' ];
      c [ label = '土' ];
      d [ label = '金' ];
      e [ label = '水' ];
      
      edge []
      a -> b -> c -> d -> e [ arrowhead = 'none' ]
      a -> c -> e -> b -> d -> a

      
      {rank = min; a;}
      {rank = same; b; e;}
      {rank = max; c; d;}

      }
      ")
  • とても惜しい感じになってますね。
  • こんな感じでグラフが自動生成されてしまうため。

  • 調整がかなり難しい。

  • layoutはいろいろある
    • dotはデフォルト
    • circo, neato, twopi, fdp, sfdp, osage

  • {rank = min; node;}は、ノードの優先順位を決める

16.3 footnumber

grViz("
      digraph c_pointer {
      
      graph [
      charset = 'UTF8',
      rankdir = LR,
      newrank = true,
      compound = true
      ]
      
      node [
      shape = 'box'
      ]
      
      subgraph cluster_a {
      
      label = '003'
      
      /*
      // 003
      003 [ label = '@@1-1' ]
      */
      // a
      a [ label = '@@1-1' ]
      }

      // *a
      pointer_pointer [ label = '@@1-2' ]
      // **a
      base_pointer_pointer [ label = '@@1-3' ]
      
      subgraph cluster_b {
      
      label = '002'
      
      /*
      // 002
      002 [ label = '@@2-1' ]
      */
      // b
      b [ label = '@@2-1' ]
      
      }
      
      // *b
      base_pointer         [ label = '@@2-2'      ]

      subgraph cluster_c {
      
      label = '001'
      
      /*
      // 001
      001 [ label = '@@3-1' ]
      */
      // c\\n114
      c [ label = '@@3-1' ]
      //      base            [ label = '114'           ]
      
      }
      
      
      
      a -> b [ lhead = cluster_b, color = red ];
      b -> c [ lhead = cluster_c,arrowtail = diamond, color = red]

      pointer_pointer -> b
      base_pointer_pointer -> c

      base_pointer -> c
      
      {rank = same; a; pointer_pointer; base_pointer_pointer;}
      {rank = same; b; base_pointer;}
      {rank = same; c;}
      
      }
      
      [1]: c( 'a\\n002', '*a\\n001', '**a\\n114')
      [2]: c( 'b\\n001', '*b\\n114')
      [3]: c( 'c\\n114')
      ")
  • subgraphでサブグラフを設定できる
    • cluster_*で名前の最初にcluster_をつける
  • @@の後に数字をつける
  • @@1-1みたいにすると複数のfootnumberをつけれる
  • [footnumber]:で属性を設定できる

  • graph graph_name {}の外はRの表現を使える

  • Rの表現式でのエスケープとhtmlにわたす改行文字の表現で\\nとなる

  • 最近、新たに脆弱性が見つかったらしい
    • ぬるぽ

16.4 mermaid

  • mermaidというグラフ生成方法もある
  • 記述が簡単
  • 優秀
  • 通常のフローチャート
  • シーケンスダイアグラム
  • ガントチャート
  • マジで優秀
  • なんどでもいう、優秀
mermaid("
graph LR
    id1[四角]
    id2(角丸)
    id3{ダイヤ}
    id4>よこっちょ削り]
    id5((円))
id1 --- id2
id2 --> id3
id3 ---|こっち| id4
id3 --円だよ--> id5
")
  • すっきりした書き心地
  • 上から順番に書いていく
  • graphは通常のグラフ
    • LR, RL, TB(TD), BTで全体の方向を指定
  • 表示する文字は直接書いてOK！
  • ただし、文字列を明示するには""でくくる
    • シングルクウォーテーションは効かない

  • そのため、mermaid('グラフ')で全体をくくる

  • 矢印はいっぱいある
    • 規則性があるのでわかりやすい
無向 有向 効果
--- --> ふつう
-.- -.-> ドット
=== ==> 太い
---|hoge| -->|hoge| テキストつき
-- hoge --- -- hoge --> テキストつき
-.->|hoge| -. hoge .-> テキストつきドット

16.5 sequenceDiagram

  • ダイアグラムも簡単に作れる
mermaid("
sequenceDiagram
  participant aomori as 新青森
  participant kikonai as 木古内
  participant hokuto as 新函館北斗
  participant hakodate as 函館

aomori->>kikonai: 新幹線
kikonai->>hokuto: 新幹線
hokuto--xhakodate: 新幹線
hokuto->>hakodate: JR

Note over aomori,kikonai: 青函トンネル
")
  • sequenceDiagramを書く
  • participant 名前で各シーケンスの名前を設定
    • participant id as 名前でid名で扱えるようになる。(エイリアス)
  • エッジ: テキストでテキストを入れられる
  • Note 配置 Actor: テキストでメモを入れられる。
    • left of, right of, over
    • Actor(ノード)を2つ設定するとまたいでNoteを入れられる。
  • 矢印はflowchartとはまた違う。
  • 例のごとくいっぱいある
無向 有向 ばってん 効果
-> ->> -x ふつう
--> -->> --x 点線

16.6 Gant diagram

  • ガントチャートのこと
mermaid("
        gantt
            title 基本情報
            dateFormat YYYY-MM-DD
            section 午前問題
            テキスト読み込み    :done, text, 2017-12-01, 30d
            午前の過去問              :done, kako_1, after text, 90d

            section 午後問題
            C言語               :done, Clang, 2018-02-01, 60d
            午後の過去問        :done, kako_2, 2018-02-01, 60d

            section 試験日程
            fe                  :crit, done, test, 2018-04-15, 1d
            合格発表            :      done, pass, 2018-05-16, 1d

            section 合格発表後
            IEEEEEEEEEEE        :active, IEEE, 2018-05-16, 10d
        ")

16.7 パイプライン

  • DiagrammeRのバージョンアップで最新版とCRAN版と関数群が変更になっているようです。
  • バージョン1.0で実行してみてください。
  • 今回は?render_graphを参考にしています。
create_graph() %>%
  # 均等なツリーをつくる
  add_balanced_tree(
    # kは分岐の数, hは深度
    k = 2, h = 3) %>%
  render_graph()
  1. create_graph()でグラフのもとを作る
  2. add_balanced_tree()で均等なツリーをグラフに追加する
  3. render_graph()でグラフの情報をレンダリングする
create_graph() %>%
  add_balanced_tree(
    k = 2, h = 3) %>%
  # layoutで構造をしていする
  render_graph(layout =
                 "nicely" #default
                 #"tree" #ツリー
                 #"circle" #円
                 #"kk" #defaultのぎゅっとしたやつ
                 #"fr" #defaultの点対称っぽい
               )
  • render_graph()で最終的なグラフの出力を指定する
create_graph() %>%
  add_balanced_tree(
    k = 2, h = 3) %>%
  # ノードのラベルを剥がす attr=NULL, nodes=NULL
  set_node_attr_to_display() %>% 
  render_graph(layout = "circle")
  • set_node_attr_to_display()のデフォルト引数が
    • attr=NULL, nodes=NULL
    • 引数を指定しない場合、情報が削除される
create_graph() %>%
  # graphのノード(n)とエッジ(m)を設定する
  # 乱数でノードとエッジを決めているようなのでset_seedを設定する
  add_gnm_graph(n = 60, m = 5
                #, set_seed = 1
                ) %>% 
  render_graph(layout = "circle")
  • add_gnm_graph()は、ノードとエッジを生成する
    • エッジのつながり方は、乱数をもとにしている
      • set_seedで再現性を保つ
create_graph() %>%
  add_balanced_tree(
    k = 2, h = 3) %>%
  # output = NULLでgrVizを利用してレンダリングされる
  # output = "visNetwork"でvisnetworkを利用してレンダリングされる
  render_graph(output = "visNetwork")
  • output = "visNetwork"とした場合は
  • 内部でDiagrammeR::visnetwork()が呼び出される
    • 引数はgraphのみなので、グラフに予め情報をセットしておく

16.8 公式(traversal)

  • ここからは公式ドキュメントをベースに
  • コードを修正していきます。

  • 公式のドキュメントが更新されるのを待ちたい。

  • trav_out(), trav_in(), trav_both()を中心に説明していく
    • trav_out()は、元のノードから外のノードとのつながり
    • trav_in()は、外から内側へのつながり
    • trav_both()は、真ん中から内側と外側へのつながり
graph_1_2 <- create_graph() %>%
  add_node() %>%
  add_node() %>%
  add_edge(1, 2) 
graph_1_2 %>% render_graph()
graph_1_2 %>% 
  select_nodes_by_id(1) %>%
  trav_out() %>%
  get_selection()
#> `select_nodes_by_id()` INFO: created a new selection of 1 node
#> `get_selection()` INFO: there is an active selection of 1 node
#> [1] 2
  • select_nodes_by_id()で選択したノードから
  • trav_out()で外側に動く
graph_2_1 <- create_graph() %>%
  add_node %>%
  add_node %>%
  add_edge(from = 2, to = 1)
graph_2_1 %>% render_graph()
graph_2_1 %>% 
  select_nodes_by_id(1) %>%
  trav_out() %>%
  get_selection()
#> `select_nodes_by_id()` INFO: created a new selection of 1 node
#> `get_selection()` INFO: there is an active selection of 1 node
#> [1] 1
  • node1に向かってエッジがあるから
    • trav_out()は外側のnode1に向かって動く
  • 逆に、trav_in()を使うとnode2に向かって動く
graph_2_1 %>% select_nodes_by_id(1) %>%
  trav_in() %>%
  get_selection()
#> `select_nodes_by_id()` INFO: created a new selection of 1 node
#> `get_selection()` INFO: there is an active selection of 1 node
#> [1] 2
  • 複数のノードがあっても同じように働く
poly_node <- create_graph() %>%
  add_n_nodes(5) %>%
  add_edge_df(create_edge_df(c(1,2,3,4), c(2,3,4,5)))
poly_node %>% render_graph(layout = "kk")
poly_node %>% 
  select_nodes_by_id(1) %>%
  trav_out() %>%
  # 2
  trav_out() %>%
  # 3
  trav_out() %>%
  # 4
  trav_out() %>%
  # 5
  get_selection()
#> `select_nodes_by_id()` INFO: created a new selection of 1 node
#> `get_selection()` INFO: there is an active selection of 1 node
#> [1] 5
  • 複数のノードがエッジでつながっていても同じ
graph_center_1 <- create_graph() %>%
  add_node() %>% # ノードがひとつだけのグラフ
  select_nodes_by_id(1) %>%
  add_n_nodes_ws(10, "from", type = "from_nodes") %>% # ノード1から
  add_n_nodes_ws(10, "to", type = "to_nodes") # ノード1に向かって
#> `select_nodes_by_id()` INFO: created a new selection of 1 node
graph_center_1 %>% render_graph(layout = "tree")
graph_center_1 %>% 
  trav_out() %>%
  get_selection()
#> `get_selection()` INFO: there is an active selection of 10 nodes
#>  [1]  2  3  4  5  6  7  8  9 10 11
  • select_nodes_by_id()でノードが選択される
    • add_n_nodes_ws()で選択したノードからノードをどっち向きに増やすかを決める
      • direction引数は、"from"か"to"のどっちか
  • trav_out()は、外側に向かう
graph_center_1 %>% 
  trav_in() %>% 
  get_selection()
#> `get_selection()` INFO: there is an active selection of 10 nodes
#>  [1] 12 13 14 15 16 17 18 19 20 21
  • trav_bothをつかうと
    • 内側、外側の両方にはたらく
graph_center_1 %>% 
  trav_both() %>% 
  get_selection()
#> `get_selection()` INFO: there is an active selection of 20 nodes
#>  [1]  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21

16.9 trav関数によるマッチ

  • trav_*のconditions引数でフィルタリングできる
    • conditionsには、条件式を入れる
#乱数使われているみたい
graph <-
  create_graph() %>%
  add_n_nodes(
    n = 1,
    type = "a",
    label = "a"
  ) %>% 
  add_n_nodes(
    n = 4,
    type = "b",
    label = "b"
  ) %>% 
  add_n_nodes(
    n = 4,
    type = "c",
    label = "c"
  ) %>% 
  add_edges_w_string(
    edges = "1->2 1->3 4->1 5->1 1->6 1->7 8->1 9->1"
  )
# View the created graph
render_graph(graph, output = "visNetwork")
  • add_n_nodes()でノードを追加する
    • nはノード数
    • typeは、文字ベクトルを入れる
      • ノードをグループに分ける
    • add_n_nodes(n = 4, type = "c")は
    • ノード数4つのcグループを追加している
  • add_edges_w_string()でエッジの方向を指定する
    • wは、たぶんwithの意味
    • string(文字列)でエッジを追加する
# さっきのグラフを更新する
update_graph <-  graph %>%
  select_nodes_by_id(nodes = 1) %>%
  trav_out(conditions = type == "c") %>%
  add_n_nodes_ws(1, direction = "from", type = "d", label = "d")
#> `select_nodes_by_id()` INFO: created a new selection of 1 node
render_graph(update_graph, output = "visNetwork")
  • select_nodes_by_id(nodes = 1)でノード1を選択
  • trav_out(conditions = type == "c")で
    • 外側に向かうノードのうちtypeがcであるノードを選択
    • 2つのノードが選択されている
  • add_n_nodes_ws()で2つのノードそれぞれから1個ずつノードを追加する
nodes <-
  create_node_df(
    n = 9,
    type = c("fruit", "fruit", "fruit",
             "veg", "veg", "veg",
             "nut", "nut", "nut"),
    label = c("pineapple", "apple",
              "apricot", "cucumber",
              "celery", "endive",
              "hazelnut", "almond",
              "chestnut"))

edges <-
  create_edge_df(
    from = c(9, 3, 6, 2, 6, 2, 8, 2, 5, 5),
    to = c(1, 1, 4, 3, 7, 8, 1, 5, 3, 6))

graph <-
  create_graph(
    nodes_df = nodes,
    edges_df = edges)

render_graph(graph, output = "visNetwork")
graph %>% 
  get_node_info()
#>   id  type     label deg indeg outdeg loops
#> 1  1 fruit pineapple   3     3      0     0
#> 2  2 fruit     apple   3     0      3     0
#> 3  3 fruit   apricot   3     2      1     0
#> 4  4   veg  cucumber   1     1      0     0
#> 5  5   veg    celery   3     1      2     0
#> 6  6   veg    endive   3     1      2     0
#> 7  7   nut  hazelnut   1     1      0     0
#> 8  8   nut    almond   2     1      1     0
#> 9  9   nut  chestnut   1     0      1     0
graph %>%
  select_nodes(
    # aではじまる(正規表現^は先頭を表すアンカー)
    conditions =  stringr::str_detect(graph$nodes_df$label, "^a")) %>%
  trav_out() %>%
  get_selection()
#> `select_nodes()` INFO: created a new selection of 3 nodes`()` INFO: created a new selection of 3 nodes
#> `get_selection()` INFO: there is an active selection of 4 nodes
#> [1] 1 3 5 8
  • バージョンアップで条件式に正規表現が使えない
    • stringr::str_detectで論理値を受け取る
  • aではじまるapple, apricot, almond
    • trav_out()でそれぞれの外側を選択
    • pineapple, apricot, celery, almondが選択される


  • 次のグラフは、trav_*の比較演算子の説明で使われていたもの
  • set_node_attrs()で、ノードの大きさを設定している
random_graph <-
  create_graph(directed = TRUE) %>% 
  add_gnm_graph(n = 5, m = 10, set_seed = 20) %>% 
  set_node_attrs(node_attr = "value", values = c(9, 8, 3, 5.5, 10))
random_graph %>% get_node_df()
#>   id type label value
#> 1  1 <NA>     1   9.0
#> 2  2 <NA>     2   8.0
#> 3  3 <NA>     3   3.0
#> 4  4 <NA>     4   5.5
#> 5  5 <NA>     5  10.0
random_graph %>% get_edge_df()
#>    id from to  rel
#> 1   1    1  5 <NA>
#> 2   2    1  3 <NA>
#> 3   3    2  1 <NA>
#> 4   4    2  5 <NA>
#> 5   5    2  3 <NA>
#> 6   6    3  4 <NA>
#> 7   7    4  5 <NA>
#> 8   8    5  1 <NA>
#> 9   9    5  2 <NA>
#> 10 10    5  4 <NA>
render_graph(random_graph, output = "visNetwork")

16.10 ノードからエッジのtraversal

  • trav_*_edge()をつかう
  • 基本的にはノードの時と変わらない
  • 最後に選択されるのが、エッジに変わるだけ
nodes <-
  create_node_df(
    n = 14,
    type = c("person", "person",
             "person", "person",
             "person", "fruit",
             "fruit", "fruit",
             "veg", "veg", "veg",
             "nut", "nut", "nut"),
    label = c("Annie", "Donna",
              "Justine", "Ed",
              "Graham", "pineapple",
              "apple", "apricot",
              "cucumber", "celery",
              "endive", "hazelnut",
              "almond", "chestnut"))

edges <-
  create_edge_df(
    from = sort(
      as.vector(replicate(5, 1:5))),
    to = as.vector(
      replicate(5, sample(6:14, 5))),
    rel = as.vector(
      replicate(
        5, sample(
                  c("likes", "dislikes","allergic_to"),
                  5,
                  TRUE,
                  c(0.5, 0.25, 0.25)
                  )
        )
      )
    )

graph <-
  create_graph(
    nodes_df = nodes,
    edges_df = edges
    )

graph %>% render_graph(output = "visNetwork")
  • forループをつかうこともできる
set.seed(20)

graph <-
  create_graph(directed = TRUE) %>% 
  add_gnm_graph(10, 20,
                set_seed = 20)

for(i in 1:count_nodes(graph)) {
  graph <-
    graph %>% 
    select_nodes_by_id(i) %>% 
    set_node_attrs(
      node_attr = "type",
      values = sample(
        c("a", "b", "c"), count_nodes(graph), replace = TRUE))
}
#> `select_nodes_by_id()` INFO: created a new selection of 1 node
#> `select_nodes_by_id()` INFO: modified an existing selection of1 node:
#> * 2 nodesare now in the active selection
#> * used the `union` set operation
#> `select_nodes_by_id()` INFO: modified an existing selection of2 nodes:
#> * 3 nodesare now in the active selection
#> * used the `union` set operation
#> `select_nodes_by_id()` INFO: modified an existing selection of3 nodes:
#> * 4 nodesare now in the active selection
#> * used the `union` set operation
#> `select_nodes_by_id()` INFO: modified an existing selection of4 nodes:
#> * 5 nodesare now in the active selection
#> * used the `union` set operation
#> `select_nodes_by_id()` INFO: modified an existing selection of5 nodes:
#> * 6 nodesare now in the active selection
#> * used the `union` set operation
#> `select_nodes_by_id()` INFO: modified an existing selection of6 nodes:
#> * 7 nodesare now in the active selection
#> * used the `union` set operation
#> `select_nodes_by_id()` INFO: modified an existing selection of7 nodes:
#> * 8 nodesare now in the active selection
#> * used the `union` set operation
#> `select_nodes_by_id()` INFO: modified an existing selection of8 nodes:
#> * 9 nodesare now in the active selection
#> * used the `union` set operation
#> `select_nodes_by_id()` INFO: modified an existing selection of9 nodes:
#> * 10 nodesare now in the active selection
#> * used the `union` set operation

for(i in 1:count_edges(graph)) {
  graph <-
    graph %>% 
    set_edge_attrs(
      from = get_edges(., return_type = "df")[i, 1],
      to = get_edges(., return_type = "df")[i, 2],
      edge_attr = "data_value",
      values = sample(
        seq(0, 8, 0.5), count_edges(graph), replace = TRUE))
}

# Look at the graph
graph %>% render_graph(output = "visNetwork")

16.11 エッジからノードのtraversal

set.seed(20)

# Create a graph with fruit,
# vegetables, nuts, and... people!
nodes <-
  create_node_df(
    n = 14,
    type = c("person", "person",
             "person", "person",
             "person", "fruit",
             "fruit", "fruit",
             "veg", "veg", "veg",
             "nut", "nut", "nut"),
    label = c("Annie", "Donna",
              "Justine", "Ed",
              "Graham", "pineapple",
              "apple", "apricot",
              "cucumber", "celery",
              "endive", "hazelnut",
              "almond", "chestnut"))

edges <-
  create_edge_df(
    from = sort(
      as.vector(replicate(5, 1:5))),
    to = as.vector(
      replicate(5, sample(6:14, 5))),
    rel = as.vector(
      replicate(
        5, sample(
          c("likes", "dislikes",
            "allergic_to"), 5,
          TRUE,
          c(0.5, 0.25, 0.25)))))

graph <-
  create_graph(
    nodes_df = nodes,
    edges_df = edges
    )

# Have a look at the graph
graph %>% render_graph(output = "visNetwork")
graph_allergies <-
  graph %>%
  select_nodes(
    conditions  = type == "person") %>%
  invert_selection() %>%
  trav_in_edge(
    conditions  = rel == "allergic_to") %>%
  trav_in_node() %>%
  set_node_attrs_ws(node_attr = "color", value = "red") %>%
  invert_selection() %>%
  set_node_attrs_ws(node_attr = "color", value = "green") %>%
  clear_selection() %>%
  select_nodes(
    conditions =  type == "person") %>%
  set_node_attrs_ws(node_attr = "color", value = "blue")
#> `select_nodes()` INFO: created a new selection of 5 nodes
#> `invert_selection()` INFO: inverted an existing selection of 5 nodes:
#> * 9 nodes are now in the active selection
#> `invert_selection()` INFO: inverted an existing selection of 5 nodes:
#> * 9 nodes are now in the active selection
#> `clear_selection()` INFO: cleared an existing selection of 9 nodes
#> `select_nodes()` INFO: created a new selection of 5 nodes
graph %>% get_edge_df
#>    id from to         rel
#> 1   1    1 13       likes
#> 2   2    1 12    dislikes
#> 3   3    1  7    dislikes
#> 4   4    1  9       likes
#> 5   5    1 10 allergic_to
#> 6   6    2 14       likes
#> 7   7    2  6       likes
#> 8   8    2 13    dislikes
#> 9   9    2  7       likes
#> 10 10    2 11 allergic_to
#> 11 11    3 12       likes
#> 12 12    3 14       likes
#> 13 13    3  6    dislikes
#> 14 14    3 10 allergic_to
#> 15 15    3 13       likes
#> 16 16    4 10 allergic_to
#> 17 17    4  8       likes
#> 18 18    4  6       likes
#> 19 19    4  7       likes
#> 20 20    4 14    dislikes
#> 21 21    5 10       likes
#> 22 22    5  6 allergic_to
#> 23 23    5  9 allergic_to
#> 24 24    5 13       likes
#> 25 25    5  7 allergic_to

# Display the modified graph, where green
# nodes represent safe foods for the
# group of people (blue nodes); red nodes
# are the danger foods
graph_allergies %>% render_graph(output = "visNetwork")

16.12 パッケージ内のファイル

  • DiagrammeRに用意されているcsvファイルを使ってのグラフ生成
contributors_csv <-
  system.file("extdata", "contributors.csv",
              package = "DiagrammeR")

colnames(read.csv(contributors_csv,
                  stringsAsFactors = FALSE))
#> [1] "name"            "age"             "join_date"       "email"          
#> [5] "follower_count"  "following_count" "starred_count"

# Create a path to the CSV file containing
# information about the software projects
projects_csv <-
  system.file("extdata/projects.csv",
              package = "DiagrammeR")

colnames(read.csv(projects_csv,
                  stringsAsFactors = FALSE))
#> [1] "project"    "start_date" "stars"      "language"

# Create a path to the CSV file with information
# about the relationships between the projects
# and their contributors
projects_and_contributors_csv <-
  system.file("extdata/projects_and_contributors.csv",
              package = "DiagrammeR")

colnames(read.csv(projects_and_contributors_csv,
                  stringsAsFactors = FALSE))
#> [1] "project_name"     "contributor_name" "contributor_role"
#> [4] "commits"

# Create the property graph by adding the CSV data to a
# new graph; the `add_nodes_from_csv()` and
# `add_edges_from_csv()` functions are used to create
# nodes and edges in the graph
graph <-
  create_graph() %>%
  set_graph_name("software_projects") %>%
  add_nodes_from_table(
    contributors_csv,
    set_type = person,
    label_col = name) %>%
  add_nodes_from_table(
    projects_csv,
    set_type = project,
    label_col = project) %>%
  add_edges_from_table(
    projects_and_contributors_csv,
    from_col = contributor_name,
    #from_mapping = "name",
    to_col = project_name,
    from_to_map = label,
    rel_col = contributor_role)

get_node_df(graph)
#>    id    type         label age  join_date                    email
#> 1   1  person          Dave  29 2012-03-23    dave_h@graphymail.com
#> 2   2  person        Louisa  32 2010-02-15    lhe99@mailing-fun.com
#> 3   3  person          Jack  35 2011-07-11        jack@ultramail.io
#> 4   4  person          Josh  27 2014-10-28      josh_ch@megamail.kn
#> 5   5  person        Sheryl  35 2009-06-20   sjo@examples-galore.fm
#> 6   6  person         Roger  43 2012-01-03 roger_that@whalemail.net
#> 7   7  person        Simone  25 2013-07-21   the_simone@a-q-w-o.net
#> 8   8  person           Kim  37 2012-02-10      kim_3251323@ohhh.ai
#> 9   9  person          Will  32 2015-07-15  the_will@graphymail.com
#> 10 10  person           Jon  41 2009-10-06      j_2000@ultramail.io
#> 11 11 project stringbuildeR  NA       <NA>                     <NA>
#> 12 12 project     supercalc  NA       <NA>                     <NA>
#> 13 13 project    randomizer  NA       <NA>                     <NA>
#>    follower_count following_count starred_count start_date stars language
#> 1             236              36            49       <NA>    NA     <NA>
#> 2             452              53           156       <NA>    NA     <NA>
#> 3              36               0             0       <NA>    NA     <NA>
#> 4              45              34            55       <NA>    NA     <NA>
#> 5             346             175           398       <NA>    NA     <NA>
#> 6             241              24            75       <NA>    NA     <NA>
#> 7             102              37           148       <NA>    NA     <NA>
#> 8            1563             485           237       <NA>    NA     <NA>
#> 9              23              76            16       <NA>    NA     <NA>
#> 10             87              24             0       <NA>    NA     <NA>
#> 11             NA              NA            NA 2013-05-28   154        R
#> 12             NA              NA            NA 2011-04-02    39    COBOL
#> 13             NA              NA            NA 2012-08-08  5328   Python

# View the graph
graph %>% render_graph(output = "visNetwork")
graph_scale_width_edges <-
  graph %>%
  select_edges() %>%
  rescale_edge_attrs(
    edge_attr_from = "commits", edge_attr_to = "width",
    to_lower_bound = 0.5, to_upper_bound = 3.0)
#> `select_edges()` INFO: created a new selection of 13 edges

# Inspect the graph's internal EDF
get_edge_df(graph_scale_width_edges)
#>    id from to         rel commits width
#> 1   1    2 11  maintainer     236 0.750
#> 2   2    1 11 contributor     121 0.627
#> 3   3    3 11 contributor      32 0.532
#> 4   4    2 12 contributor      92 0.596
#> 5   5    4 12 contributor     124 0.630
#> 6   6    5 12  maintainer    1460 2.059
#> 7   7    4 13  maintainer     103 0.608
#> 8   8    6 13 contributor     236 0.750
#> 9   9    7 13 contributor     126 0.633
#> 10 10    8 13 contributor    2340 3.000
#> 11 11    9 13 contributor       2 0.500
#> 12 12   10 13 contributor      23 0.522
#> 13 13    2 13 contributor     287 0.805

# View the graph, larger edges and arrows
# indicate higher numbers of `commits`
graph_scale_width_edges %>% render_graph(output = "visNetwork")
graph_scale_color_edges <-
  graph %>%
  select_edges() %>%
  rescale_edge_attrs(
    edge_attr_from = "commits", edge_attr_to ="color",
    to_lower_bound = "gray95", to_upper_bound =  "gray5")
#> `select_edges()` INFO: created a new selection of 13 edges

# Render the graph, darker edges represent higher
# commits
graph_scale_color_edges %>% render_graph(output = "visNetwork")
graph <-
  graph %>% 
  add_edge(
    get_node_ids(.,
      conditions = label == "Kim"),
    get_node_ids(.,
      conditions = label == "stringbuildeR"),
    "contributor") %>%
  select_last_edges_created() %>%
  set_edge_attrs_ws("commits", 15) %>%
  clear_selection()
#> `clear_selection()` INFO: cleared an existing selection of 1 edge

# View the graph's internal EDF, the newest
# edge is at the bottom
get_edge_df(graph)
#>    id from to         rel commits
#> 1   1    2 11  maintainer     236
#> 2   2    1 11 contributor     121
#> 3   3    3 11 contributor      32
#> 4   4    2 12 contributor      92
#> 5   5    4 12 contributor     124
#> 6   6    5 12  maintainer    1460
#> 7   7    4 13  maintainer     103
#> 8   8    6 13 contributor     236
#> 9   9    7 13 contributor     126
#> 10 10    8 13 contributor    2340
#> 11 11    9 13 contributor       2
#> 12 12   10 13 contributor      23
#> 13 13    2 13 contributor     287
#> 14 14    8 11 contributor      15


# View the graph to see the new edge
graph %>% render_graph(output = "visNetwork")
  • まだまだありますが、ここでやめておきます。
  • CRANからインストールした場合、バージョンはstableになるので修正版は使えない

17 動的処理

17.1 小手調べ

  • 通常、Rではメモリを先に確保する
    • 静的なうごきのほうが速い、軽い
  • でも文字列をオブジェクトにすることがある
    • 動的なうごきは遅い、重い
    • どれだけのメモリを確保すればいいかわからない
  • Rは動的型付けの関数型言語
    • 関数型と手続き型の中間型かな

17.2 関数型

  • function(fun) fun()って感じのやつ
  • ほかにもラムダとか使えるらしい
  • 詳しくはhaskell, F#に任せたい。
  • lambdaRパッケージもある。
testa <- function() print("a")

testfun <- function(fun) {fun(); print(environment())}
replicate(3, testfun(testa))
#> [1] "a"
#> <environment: 0xf39def8>
#> [1] "a"
#> <environment: 0xf2b6b90>
#> [1] "a"
#> <environment: 0xedf2878>
#> [[1]]
#> <environment: 0xf39def8>
#> 
#> [[2]]
#> <environment: 0xf2b6b90>
#> 
#> [[3]]
#> <environment: 0xedf2878>

17.3 匿名関数

  • 名前のない関数
  • fun = function(){}とかのやつ
  • applyファミリー, prrr::map*, stat_functionとかで使う
  • 直接は関係ないけど、()でくくると代入式でもリターンしてくれる
(function(a, b) a + b)(a = 1, b = 2)
#> [1] 3
(test_unknown <- "Hello")
#> [1] "Hello"
(function(var, n) {
  tmp <- var
  for(i in 1:n) {
  var <- (var + tmp/var) / 2
  }
  return(var)})(2, 10)
#> [1] 1.414214

17.4 do.call関数

  • do.call()は文字列を関数として扱うことができます。
  • そこまで、難しいことは無いと思う。
  • quoteとenvirは…評価タイミングがわかりにくい

17.4.1 whatとargs

  • whatは、関数のこと
    • 文字列でも、関数オブジェクトでもOK!
  • args(引数)はlist型にする
do.call("rnorm", args = c(5))
#> Error in do.call("rnorm", args = c(5)): second argument must be a list
set.seed(20); do.call("rnorm", args = list(5))
#> [1]  1.1626853 -0.5859245  1.7854650 -1.3325937 -0.4465668
set.seed(20); do.call(rnorm, args = list(5))
#> [1]  1.1626853 -0.5859245  1.7854650 -1.3325937 -0.4465668

17.4.2 quote

  • オブジェクトを展開するかどうか
  • TRUEだとオブジェクトを評価しない
    • 文字列っぽく扱う
age <- 20
do.call(paste, list(age, "歳ですよ", sep = ""), quote = FALSE)
#> [1] "20歳ですよ"
do.call(paste, list(age, "歳ですよ", sep = ""), quote = TRUE)
#> [1] "20歳ですよ"

do.call(paste, list(as.name(age), "歳ですよ", sep = ""), quote = FALSE)
#> Error in (function (..., sep = " ", collapse = NULL) : object '20' not found
do.call(paste, list(as.name("age"), "歳ですよ", sep = ""), quote = FALSE)
#> [1] "20歳ですよ"
do.call(paste, list(as.name(age), "歳ですよ", sep = ""), quote = TRUE)
#> [1] "20歳ですよ"
  • ちなみに
  • name型は、symbol型のエイリアス(別名てきなやつ)
    • Rubyでいうsymbolとcharacterみたいな感じ :symbol, "character"
as.name(age)  ; as.name("age")
#> `20`
#> age
as.symbol(age); as.symbol("age")
#> `20`
#> age
  • 基本的には、ここまでの引数だけで十分だと思います
  • envirについては、レキシカルスコープが絡むので、今回は省く

17.5 substitute関数

  • 置換する関数
  • こっちもenvはlist型をうけとる
set.seed(20)
(hoge <- rnorm(5))
#> [1]  1.1626853 -0.5859245  1.7854650 -1.3325937 -0.4465668
(names(hoge) <- c("test1", "test2", "test3", "test4", "test5"))
#> [1] "test1" "test2" "test3" "test4" "test5"
substitute(max(hoge))
#> max(hoge)
substitute(max(test1))
#> max(test1)
substitute(max("test1"))
#> max("test1")
substitute(max("test1"), env = hoge)
#> Error in substitute(max("test1"), env = hoge): invalid environment specified
  • .GlobalEnvにオブジェクトがあっても勝手に置換されない

17.5.1 置換の挙動

  • ダブルクウォーテーションでくくると置換しない
hoge <- as.list(hoge)
substitute(max(test1))
#> max(test1)
substitute(max("test1"))
#> max("test1")
substitute(max("test1"), env = hoge)
#> max("test1")
substitute(max(test1), env = hoge)
#> max(1.1626852897838)
  • マッチの仕方を見てみる
hoge$test12 <- {set.seed(20); rnorm(5)}
hoge$test12
#> [1]  1.1626853 -0.5859245  1.7854650 -1.3325937 -0.4465668
substitute(max(test12), env = hoge)
#> max(c(1.1626852897838, -0.585924465893051, 1.78546500331661, 
#> -1.33259371048501, -0.446566766553219))
  • 最長の文字列とマッチしていますね
  • test1とはマッチしていない

17.5.2 exprの型

  • substitute()の第一引数expr
  • なぜか、中身が展開されない
  • 型を見てみると
fuga <- substitute(max(test1), env = hoge)
fuga
#> max(1.1626852897838)
class(fuga) 
#> [1] "call"
mode(fuga)
#> [1] "call"
typeof(fuga)
#> [1] "language"
class(fuga) <- "character"
fuga
#> [1] "max"             "1.1626852897838"
  • 結果は
class mode typeof
call call language

  • つまり、文字列ではない

  • 最後の、classをcharacterにすると

  • ベクトルになっている

17.6 eval関数

  • evalは、表現式を実行します。
  • 文字列だとびみょー
set.seed(20)
eval("rnorm(5)")
#> [1] "rnorm(5)"
eval(rnorm("5"))
#> [1]  1.1626853 -0.5859245  1.7854650 -1.3325937 -0.4465668
  • 関数部分は、文字列にすると動かない

17.6.1 evalqもある

  • 引数の評価をしない
  • 表現式を表現式のままうけとる
    • qはquoteという意味
      • くくる
eval(rnorm(a), envir = list(a = 5))
#> Warning in rnorm(a): NAs introduced by coercion
#> Error in rnorm(a): invalid arguments
evalq(rnorm(a), envir = list(a = 5))
#> [1]  0.5696061 -2.8897176 -0.8690183 -0.4617027 -0.5555409
  • evalの方は、aを展開しようとする

17.7 eval, substitute, do.call

  • いよいよ動的処理
  • 今は、evalとsubstituteとdo.callを使うのが主流らしい
  • evalとparseでは遅いらしい
str(hoge)
#> List of 6
#>  $ test1 : num 1.16
#>  $ test2 : num -0.586
#>  $ test3 : num 1.79
#>  $ test4 : num -1.33
#>  $ test5 : num -0.447
#>  $ test12: num [1:5] 1.163 -0.586 1.785 -1.333 -0.447

substitute(max(test12), env = hoge)
#> max(c(1.1626852897838, -0.585924465893051, 1.78546500331661, 
#> -1.33259371048501, -0.446566766553219))

eval(
  substitute(
    max(test12),
    env = hoge
  )
)
#> [1] 1.785465

17.8 速度

microbenchmark::microbenchmark(
  esd = function() eval(substitute(do.call(func, args = list(n = 30)), env = list(func = "rnorm"))),
   ep  = function() eval(parse(text = paste0("rnorm", "(", "n" ,")")), envir = list(n = 30)),
   times = 20
 )
#> Unit: nanoseconds
#>  expr min    lq   mean median    uq  max neval
#>   esd 369 387.0 398.45  394.5 405.5  491    20
#>    ep 372 378.5 791.85  398.0 414.0 5611    20
  • meanを見るとesdのほうが速いですね

18 ポインタ

18.1 ポインタとは

  • C言語とかでよくみる

  • Rだとポインタはないことになってる

  • ここからはC言語をベースにしていきたいと思います

  • ポインタというのは、値が入っているメモリのアドレスを参照すること

  • 足し算をしてみると

void plusfunc(double *x, double *y, double *res) {
  *res = *x + *y;
}
#> gcc -m64 -std=gnu99 -I/usr/include/R -DNDEBUG   -I/usr/local/include   -fpic  -O2 -g -pipe -Wall -Wp,-D_FORTIFY_SOURCE=2 -fexceptions -fstack-protector-strong --param=ssp-buffer-size=4 -grecord-gcc-switches   -m64 -mtune=generic  -c ce3f7afd07e4.c -o ce3f7afd07e4.o
#> gcc -m64 -std=gnu99 -shared -L/usr/lib64/R/lib -Wl,-z,relro -o ce3f7afd07e4.so ce3f7afd07e4.o -L/usr/lib64/R/lib -lR
a <- 5; b <- 6; res <- 0;
.C('plusfunc',as.numeric(a), as.numeric(b), res = as.numeric(res) )
#> [[1]]
#> [1] 5
#> 
#> [[2]]
#> [1] 6
#> 
#> $res
#> [1] 11
  • 図にしてみると
grViz("
      digraph graph_pointer_c {
        graph [ rankdir = RL,
                newrank = true ] // --------------------

        node [ shape = box ] // ------------------------

        subgraph cluster_a {
          label = 'aのアドレスと値'

          a_address [ label = 'aのアドレス\n120' ]

          a [label = 'a\n6']
        }

        subgraph cluster_x {
          label = 'xのアドレスと値'

          x_address [ label = 'xのアドレス\n200' ]

          x [ label = 'x\n120' ]

          x_pointer [ label = '*x\n6' ]
        }

        edge [] // ------------------------

        a_address -> x [ color = '#ff0000' ]
        x_pointer -> a [ color = '#660000' ]

      {rank = max; x_address; x; x_pointer}
      {rank = min; a_address; a;}
      }")
  • こんな感じ
  • aのアドレスである120が、ポインタxの値になっている
  • ポインタxの指し示す値が6になっている
    • 厳密には少し違う

18.2 Rはポインタ

  • Rのオブジェクトはポインタ
  • アドレスの部分を張り替えているだけ
  • つまり、同じ値だったらアドレス同じでいいじゃん
a <- 2
a
#> [1] 2

a <- "char"
a
#> [1] "char"

a <- TRUE
a
#> [1] TRUE

18.3 Rのメモリ

  • メモリに値を保存している
  • では、メモリ量はどれぐらい使っているか
# r4dsだとdiamondsを使っている
mtcars2 <- mtcars
pryr::object_size(mtcars)
#> 6.74 kB
pryr::object_size(mtcars2)
#> 6.74 kB
pryr::object_size(mtcars, mtcars2)
#> 6.74 kB
  • 2つ合わせても6.74kBですべて一致している
mtcars3 <- mtcars %>% 
  mutate(tpg = mpg / ( 4 * qsec ))
pryr::object_size(mtcars)
#> 6.74 kB
pryr::object_size(mtcars3)
#> 4.95 kB
pryr::object_size(mtcars, mtcars3)
#> 7.68 kB
  • mtcars3でむしろメモリ量へってる
  • 2つあわせると増えてる
    • やっぱり、合わせた値じゃない
as_tibble(mtcars) %>% head() %>% 
  knitr::kable()
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1 
as_tibble(mtcars3) %>% head() %>% 
  knitr::kable()
mpg cyl disp hp drat wt qsec vs am gear carb tpg
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4 0.3189550
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4 0.3084606
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1 0.3062869
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1 0.2752058
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2 0.2746769
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1 0.2237883
  • ちゃんと一列増えている
  • メモリが節約されてる
  • おそらくアドレスが共有されている
grViz("
      digraph memory_image {
        graph [ charset = 'UTF-8',
                rankdir = BT,
                compound = true
              ]

        node [ shape = egg ]

        subgraph cluster_value {
          
          mpg; cyl; disp;
          hp; drat; wt;
          qsec; vs; am;
          gear; carb;
        }

        tpg;

        mtcars;
        mtcars3;

        edge[]

        mtcars -> wt [ lhead = cluster_value, headport = s ]
        mtcars3 -> disp [ lhead = cluster_value, headport = s ]
        mtcars3 -> tpg

      }")

さいごに

今回は、ShinyやDiagrammeR, C言語をメインに紹介しました。
まだまだ、紹介しきれていないことも多いので、
ぜひ、次回の開催ができるようにしていきたいと思います。

Enjoy!

付録

A 環境構築

A.1 virtualbox

  • windowsは,インストーラで一発
    • 最近は、Docker for windowsが主流らしい
      • windows10だと導入が簡単
    • R用のイメージ rocker もある
  • linuxは、めんどい
    • ubuntu系は、apt-getに用意されてるっぽい
$ sudo apt-get install virtualbox
  • 公式の手順通りにすすめると
  • 以下、debian系
sudo vim /etc/apt/sources.list

ここに、

deb https://download.virtualbox.org/virtualbox/debian xenial contrib

これを追加する。

wget -q https://www.virtualbox.org/download/oracle_vbox_2016.asc -O- | sudo apt-key add -
wget -q https://www.virtualbox.org/download/oracle_vbox.asc -O- | sudo apt-key add -

sudo apt-get update
sudo apt-get install virtualbox-5.2

vboxmanage -v

A.2 vagrant

  • vagrantのboxイメージにいろんな仮想環境が用意されている
wget https://releases.hashicorp.com/vagrant/2.1.2/vagrant_2.1.2_x86_64.deb

sudo dpkg -i vagrant_2.1.2_x86_64.deb

vagrant -v
  • たぶん、これでインストールできたはず

A.3 boxイメージ

  • vagrant cloudでほしい環境を探す
  • 今回はcentos/7を使う
vagrant box add centos/7

このとき、

3) virtualbox

と選択を迫られたら、
3を入力して、Enter

vagrant box list
mkdir -p ~/vagrant/centos7

cd ~/vagrant/centos7

vagrant init

# もしエラーが出たら

vagrant init centos7

A.4 rstudio-server

  • Vagrantfileのあるところで
vagrant ssh

  • これでcentosにログインできたと思います

  • これからRとrstudio-serverをインストールします

sudo yum install epel-release

sudo yum --enablerepo=epel install R

sudo yum install wget

wget https://download2.rstudio.org/rstudio-server-rhel-1.1.442-x86_64.rpm

ls

sudo yum install rstudio-server-rhel-1.1.442-x86_64.rpm

A.5 Vagrantfile

  • Vagrantfileでvagrantの設定ができる
  • Nginxとrstudio-server, Shiny-serverをインストールすると
    • ブラウザとどっかのポートがぶつかる
      • 80番がどっかで2回使われている
    • ポートやipアドレスの理解が必要

というわけで、割愛！
調整できたら、載せます

A.6 Nginx

  • リバースプロキシ
    • サーバーに命令したりする
  • 最近の主流
  • インストールと自動起動だけのせとく
sudo vim /etc/yum.repos.d/nginx.repo
  • これを、
[nginx]
name=nginx repo
baseurl=http://nginx.org/packages/centos/7/$basearch/
gpgcheck=0
enabled=1
  • 追加する
sudo yum -y --enablerepo=nginx install nginx

nginx -v
  • いらないけど一応
sudo yum -y install net-tools
  • 自動起動設定
sudo systemctl enable nginx
  • 起動
sudo systemctl start nginx

A.7 Shiny-server

  • 公式のやり方でOK
  • ダウンロード方法
    • Pro版だと、サポートが受けられる
      • ログイン時に鍵をかけれる
  • まず、shinyパッケージ必要
sudo su - \
-c "R -e \"install.packages('shiny', repos='https://cran.rstudio.com/')\""

  • repos は、お近くのサーバーで良いかと

  • あとは、インストール

wget https://download3.rstudio.org/centos6.3/x86_64/shiny-server-1.5.7.907-rh6-x86_64.rpm
sudo yum install --nogpgcheck shiny-server-1.5.7.907-rh6-x86_64.rpm
  • 自動起動設定
sudo systemctl enable shiny-server
sudo systemctl start shiny-server
  • Nginxをつなげると、https化も出来る

A.7.1 パッケージのインストール

  • shiny-serverでつかうパッケージをインストールする
  • rmarkdownの部分は適宜、パッケージ名で置き換えてください
sudo su - -c "R -e \"install.packages('rmarkdown', repos='https://cran.rstudio.com/')\""

B 正規表現

もし、わかりにくかったら連絡ください。 修正します。

B.1 メタキャラクタ

通常の正規表現で使えるのは、以下のメタキャラクタ

メタキャラクタ 効果
. 任意の一文字
* 0回以上の繰り返し
[文字] どれか文字にマッチする
^ アンカー、先頭のこと
$ アンカー、末尾のこと
{n,m} n回以上、m回以下の繰り返し
\(…\) \(と\)で囲まれた文字列を保存する
\ エスケープ

B.2 拡張メタキャラクタ

拡張正規表現に対応しているもので使用可能。

拡張メタキャラクタ 効果 通常のメタキャラクタでの表現
+ 1回以上の繰り返し \{1,\} または ..*
? 0回か1回の連続 \{0,1\}
またはの意味(優先度高い)

ただし、使用する言語、ソフトによっては別の拡張メタキャラクタセットを使用可能。

B.3 使用例

#vimを探してみる
dpkg -l | grep 'vim'

#前後に任意の文字が0個以上あるもの
dpkg -l | grep '.*vim.*'

#vimのみを探してみる
#前後のスペースを一回以上にしてみる
dpkg -l | grep ' \{1,\}vim \{1,\}'

#こんな感じにも書ける
dpkg -l | grep '  *vim  *'
  • \{n,m\}は、繰り返しを指定する。
    • \{n,\}でn回以上の繰り返し
    • \{,m\}でm回以下の繰り返し
  • .は任意の一文字
  • *は0回以上の繰り返し
    • .*は任意の一文字の0回以上の繰り返し
    • ..*で任意の一文字の1回以上の繰り返し
      • 任意の一文字と任意の一文字の0回以上の繰り返し

B.4 Rでの正規表現

  • Rでは、文字列表現と正規表現が区別される
  • 正規表現で\を使いたい場合は、
  • 文字列表現で\\と\を重ねる必要がある
escape <- "this is tasty."
writeLines(escape)
#> this is tasty.
#str_extract(escape, "\.")
#> Error: '\.' is an unrecognized escape in character string starting ""\."
str_extract(escape, "\\.")
#> [1] "."
str_extract(escape, "..*\\.")
#> [1] "this is tasty."

mermaid("
        graph LR
        str[文字列]
        reg[正規表現]
        pat[パターン]

        str-->|\\|reg
        reg-->|\\|pat
        ")

C Sed

文字列の置換に便利な言語

C.1 代表的なコマンド

コマンド 効果　 表現
s 置換する /アドレス/s/パターン/置換後のパターン/
y パターンで指定したものを入れ替える y/パターン/パターン/
p 表示する アドレス/p
d 削除して一行目に戻る アドレス/d

他にも大文字コマンドがあるが、使用方法が難しいので今回は割愛します。

C.2 使用例

#vimをemacsにしてみる
dpkg -l | grep 'vim' | sed -e 's/vim/emacs/'

#Vim vim Vi vi などのすべてをemacsにしてみる
#最後のgrepはemacsをハイライトさせるため
dpkg -l | grep '[Vv][Ii][Mm]*' | sed -e 's/[Vv][Ii][Mm]*/emacs/' | grep 'emacs'

#Vim vim Vi vi だけをemacsにしてみる
dpkg -l | grep '[Vv]im*' | sed -e 's/[Vv]im*/emacs/' | grep 'emacs'
#このやり方だとvideoなども含まれる

#もう一度やりなおす
dpkg -l | grep '[^a-z][Vv]im*[^a-z]' | sed -e 's/[^a-z][Vv]im*[^a-z]/emacs/' | grep 'emacs'
#だいぶ直ったけど、Vi IMprovedはのこったまま

#Vi IMprovedもemacsに変えてみる
dpkg -l | grep '[^a-z][Vv]im*[^a-z]' | sed -e 's/[^a-z][Vv]im*[^a-z]/emacs/' | sed -e 's/Vi IMproved/emacs/' | grep 'emacs'

grepの抽出とsedのパターン指定が重複してるけど、あんまり意味はない
強いて言うなら、sedのアドレス指定を明示的にするため

grep '[^a-z][Vv]im*[^a-z]' | sed -e 's/[^a-z][Vv]im*[^a-z]/emacs/'  
sed -e '/[^a-z][Vv]im*[^a-z]/s/[^a-z][Vv]im*[^a-z]/emacs/'  
sed -e '/[^a-z][Vv]im*[^a-z]/s//emacs/'

すべて等価な表現

  • [Vv]はVとvどっちかにマッチする
  • [Mm]*は(Mとmどっちかにマッチする)の0回以上の繰り返し
  • [a-z]はaからzのすべてのうちどれか一つにマッチする
  • [^a-z]は(aからzのすべてのうちどれか一つ)とマッチしない

C.3 使用例2

#viなどをemacs単体に変えて表示
dpkg -l | sed -n -e '/..*[^a-z]\([Vv]im*\)[^a-z]..*/s//\1toemacs/p'

sedのオプション -n は自動出力をやめるオプション
pコマンドは表示させるオプション
pの後ろにスラッシュはいらない

  • \(文字列\)で保存できる
  • 参照は\1,\2のように\の後に数字をつける
    • \(a\)``\(b\)のように複数保存した場合、参照は手前から順に1,2,となる
  • \([Vv]im*\)を保存して参照すると、viとなっている。
    • m* は0回として保存